怎样用Excel表格里的名字找图片(excel表格怎么按照图片名称)

相关学习推荐：excel教程

如何将图片从一张工作表插入到另外一张工作表呢？举个例子。

如下图：

一份工作簿有两张工作表。

存放照片的工作表名为【照片】，需要插入图片的工作表名为【数据】。

现在需要根据【数据】表的A列的图片名称，将【照片】表的照片批量插入到【数据】表的B列中去……

示例动画如下：

……

实现这样的功能，其实3句代码就够了。

代码如下：

SubInsertPicFromSheet)DimrngDataAsRange,rngPicNameAsRangeForEachrngDataInRange("a2",Cells(Rows.Count,).End)SetrngPicName=Sheets("照片).Cells.Find(rngData.Value,,,xlWhol)'使用Find方法在照片表完整匹配姓名IfNotrngPicNameIsNothingThenrngPicName.Offset(0,).CopyrngData.Offset(0,)'如果有找到对应的姓名，则将照片复制粘贴到目标位置NextEndSub登录后复制

不过……

以上代码最大的问题在于，没有删除数据表原本就有旧图片，如果重复运行程序，会造成图片累积，为了解决这个问题，我们需要再加上两句代码。

代码修改如下：

SubInsertPicFromSheet)DimshpAsShape,rngDataAsRange,rngPicNameAsRangeForEachshpInActiveSheet.Shapes'删除活动工作表原有照片Ifshp.Type=13Thenshp.DeleteNextForEachrngDataInRange("a2",Cells(Rows.Count,).End)SetrngPicName=Sheets("照片).Cells.Find(rngData.Value,,,xlWhol)'使用Find方法在照片表的完整匹配姓名IfNotrngPicNameIsNothingThenrngPicName.Offset(0,).CopyrngData.Offset(0,)'如果有找到对应的姓名，则将照片复制粘贴到目标位置NextEndSub登录后复制

以上代码使用一刀切的方式删除了旧有的图片。

二不过……

尽管这段代码对于VBA基础良好的朋友来说，稍微修改下，已经足够应对大部分的问题，但是，对于小白而言，显然不够友好……

比如说……

1、照片的姓名固定在数据表的A列，实际情况，很可能不是A列，我说的对。

2、放置照片的位置固定于姓名列向右移动1列的单元格，实际情况，当然也很可能不是这样，我说的还是对。

3、代码中将储存照片的工作表固定设置为sheets(“照)，实际情况，肯定很可能不是这样，我英明……

4、代码未设置单元格的大小以适应图片的大小，我……

代码修改如下：

SubInsertPicFromSheet2)'ExcelHomeVBA编程学习与实践by:看见星光DimrngDataAsRange,rngWhereAsRange,cllAsRangeDimrngPicNameAsRange,rngPicAsRange,rngPicPasteAsRangeDimshpAsShape,shtAsWorksheet,blnAsBooleanDimstrWhereAsString,strPicNameAsString,strPicShtNameAsStringDimx,yAsLong,lngYesCountAsLong,lngNoCountAsLong'OnErrorResumeNextSetrngData=Application.InputBox("请选择应插入图片名称的单元格区域",Type:=)'用户选择需要插入图片的名称所在单元格范围SetrngData=Intersect(rngData.Parent.UsedRange,rngDat)'intersect语句避免用户选择整列单元格，造成无谓运算的情况IfrngDataIsNothingThenMsgBox"选择的单元格范围不存在数据！":ExitSubstrWhere=InputBox("请输入放置图片偏移的位置，例如上1、下1、左1、右1",,"右1)'用户输入图片相对单元格的偏移位置IfLen(strWher)=0ThenExitSubx=Left(strWhere,)'偏移的方向IfInStr("上下左右",)=0ThenMsgBox"你未输入偏移方位。":ExitSuby=Val(Mid(strWhere,))'偏移的值SelectCasexCase"上"SetrngWhere=rngData.Offset(y,)Case"下"SetrngWhere=rngData.Offset(y,)Case"左"SetrngWhere=rngData.Offset(0,)Case"右"SetrngWhere=rngData.Offset(0,)EndSelectstrPicShtName=InputBox("请输入存放图片的工作表名称",,"照片)ForEachshtInWorksheetsIfsht.Name=strPicShtNameThenbln=TrueNextIfbln<>TrueThenMsgBox"未找到保存图片的工作表："&strPicShtName&vbCrLf&"程序退出。":ExitSubApplication.ScreenUpdating=FalserngData.Parent.SelectForEachshpInActiveSheet.Shapes'如果旧图片存放在目标图片存放范围则删除IfNotIntersect(rngWhere,shp.TopLeftCel)IsNothingThenshp.DeleteNextx=rngWhere.RowrngData.Rowy=rngWhere.ColumnrngData.Column'偏移的纵横坐标ForEachcllInrngData'遍历选择区域的每一个单元格strPicName=cll.Text'图片名称IfLen(strPicNam)Then'如果单元格存在值SetrngPicName=Sheets(strPicShtNam).Cells.Find(cll.Value,,,xlWhol)'使用Find方法在照片表完整匹配姓名IfNotrngPicNameIsNothingThenSetrngPicPaste=cll.Offset(x,)'粘贴图片的单元格SetrngPic=rngPicName.Offset(0,)'保存图片的单元格lngYesCount=lngYesCount+1'累加找到结果的个数IflngYesCount=1Then'设置放置图片单元格的行高和列宽，以适应图片的大小rngPicPaste.RowHeight=rngPic.RowHeightrngPicPaste.ColumnWidth=rngPic.ColumnWidthEndIfrngPicName.Offset(0,).CopyrngPicPaste'如果有找到对应的姓名，则将照片复制粘贴到目标位置ElselngNoCount=lngNoCount+1'累加未找到结果的个数EndIfEndIfNextApplication.ScreenUpdating=TrueMsgBox"共处理成功"&lngYesCount&"个对象，另有"&lngNoCount&"个非空单元格未找到对应的图片名称。"EndSub登录后复制

以上代码解决了我们前面说的常见的三点问题……

然……三不过……

还是有一些实际应用中可能出现的问题未解决……

比如说……

1、如何解决图片和数据源的联动性？当数据源图片更改的时候，数据表的图片也自动更改？嗯，除了重新运行程序，也可以使用工作表的激活事件，或者是使用activesheet.chartobjects.add……

2、如何设置图片的大小适应单元格，而不是调整单元格的大小适应图片？

相关学习推荐：excel教程

以上就是Excel简单搞定怎么按名称查询图片的详细内容，更多请关注东辰网其它相关文章！