Excel简单搞定怎么按名称查询图片

好酷屋

发布于2023-02-19

好酷屋教程网小编为您收集和整理了Excel简单搞定怎么按名称查询图片的相关教程：本篇文章给大家带来了关于excel的相关知识，其中主要整理了怎么按名称查询图片的相关问题，包括了如何将图片从一张工作表插入到另外一张工作表、根据数据表的A列的图片名称，将照片表的照片批量插入到数据表的

本篇文章给大家带来了关于excel的相关知识，其中主要整理了怎么按名称查询图片的相关问题，包括了如何将图片从一张工作表插入到另外一张工作表、根据数据表的A列的图片名称，将照片表的照片批量插入到数据表的B列中等等内容，下面一起来看一下，希望对大家有帮助。

手机如何做表格：点击查看

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

如下图：

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

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

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

示例动画如下：

……

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

代码如下：

Sub InsertPicFromSheet()Dim rngData As Range, rngPicName As RangeFor Each rngData In Range("a2", Cells(Rows.Count, 1).End(3))Set rngPicName = Sheets("照片").Cells.Find(rngData.Value, , , xlWhole)'使用Find方法在照片表完整匹配姓名If Not rngPicName Is Nothing Then rngPicName.Offset(0, 1).Copy rngData.Offset(0, 1)'如果有找到对应的姓名，则将照片复制粘贴到目标位置NextEnd Sub

不过……

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

代码修改如下：

Sub InsertPicFromSheet()Dim shp As Shape, rngData As Range, rngPicName As RangeFor Each shp In ActiveSheet.Shapes'删除活动工作表原有照片If shp.Type = 13 Then shp.DeleteNextFor Each rngData In Range("a2", Cells(Rows.Count, 1).End(3))Set rngPicName = Sheets("照片").Cells.Find(rngData.Value, , , xlWhole)'使用Find方法在照片表的完整匹配姓名If Not rngPicName Is Nothing Then rngPicName.Offset(0, 1).Copy rngData.Offset(0, 1)'如果有找到对应的姓名，则将照片复制粘贴到目标位置NextEnd Sub

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

二不过……

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

比如说……

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

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

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

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

代码修改如下：

Sub InsertPicFromSheet2()'ExcelHome VBA编程学习与实践 by:看见星光Dim rngData As Range, rngWhere As Range, cll As RangeDim rngPicName As Range, rngPic As Range, rngPicPaste As RangeDim shp As Shape, sht As Worksheet, bln As BooleanDim strWhere As String, strPicName As String, strPicShtName As StringDim x, y As Long, lngYesCount As Long, lngNoCount As Long'On Error Resume NextSet rngData = Application.InputBox("请选择应插入图片名称的单元格区域", Type:=8)'用户选择需要插入图片的名称所在单元格范围Set rngData = Intersect(rngData.Parent.UsedRange, rngData)'intersect语句避免用户选择整列单元格，造成无谓运算的情况If rngData Is Nothing Then MsgBox "选择的单元格范围不存在数据！": Exit SubstrWhere = InputBox("请输入放置图片偏移的位置，例如上1、下1、左1、右1", , "右1")'用户输入图片相对单元格的偏移位置If Len(strWhere) = 0 Then Exit Subx = Left(strWhere, 1)'偏移的方向If InStr("上下左右", x) = 0 Then MsgBox "你未输入偏移方位。": Exit Suby = Val(Mid(strWhere, 2))'偏移的值Select Case xCase "上"Set rngWhere = rngData.Offset(-y, 0)Case "下"Set rngWhere = rngData.Offset(y, 0)Case "左"Set rngWhere = rngData.Offset(0, -y)Case "右"Set rngWhere = rngData.Offset(0, y)End SelectstrPicShtName = InputBox("请输入存放图片的工作表名称", , "照片")For Each sht In WorksheetsIf sht.Name = strPicShtName Then bln = TrueNextIf bln True Then MsgBox "未找到保存图片的工作表：" & strPicShtName & vbCrLf & "程序退出。": Exit SubApplication.ScreenUpdating = FalserngData.Parent.SelectFor Each shp In ActiveSheet.Shapes'如果旧图片存放在目标图片存放范围则删除If Not Intersect(rngWhere, shp.TopLeftCell) Is Nothing Then shp.DeleteNextx = rngWhere.Row - rngData.Rowy = rngWhere.Column - rngData.Column'偏移的纵横坐标For Each cll In rngData'遍历选择区域的每一个单元格strPicName = cll.Text'图片名称If Len(strPicName) Then'如果单元格存在值Set rngPicName = Sheets(strPicShtName).Cells.Find(cll.Value, , , xlWhole)'使用Find方法在照片表完整匹配姓名If Not rngPicName Is Nothing ThenSet rngPicPaste = cll.Offset(x, y)'粘贴图片的单元格Set rngPic = rngPicName.Offset(0, 1)'保存图片的单元格lngYesCount = lngYesCount + 1'累加找到结果的个数If lngYesCount = 1 Then'设置放置图片单元格的行高和列宽，以适应图片的大小rngPicPaste.RowHeight = rngPic.RowHeightrngPicPaste.ColumnWidth = rngPic.ColumnWidthEnd IfrngPicName.Offset(0, 1).Copy rngPicPaste'如果有找到对应的姓名，则将照片复制粘贴到目标位置ElselngNoCount = lngNoCount + 1'累加未找到结果的个数End IfEnd IfNextApplication.ScreenUpdating = TrueMsgBox "共处理成功" & lngYesCount & "个对象，另有" & lngNoCount & "个非空单元格未找到对应的图片名称。"End Sub

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

然……三不过……

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

比如说……

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

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

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