在Excel中按名称查询照片很简单（如何在Excel中按名称搜索照片）

本文提供了有关Excel的相关知识。 主要整理了如何按名称查询图像的相关问题，例如如何将图像从一个工作表插入到另一个工作表、如何根据数据插入图像等。 我们来看看如何将照片名称插入到表的 A 列中，以及如何将照片表中的照片一次性插入到数据表的 B 列中。 我希望这对你有帮助。

相关学习推荐：Excel教程

将一张工作表中的图像插入到另一张工作表中如何制作毛织物？一个例子。

如下图：

工作簿有两个工作表。

要保存照片的工作表名称为“照片”，需要插入照片的工作表名称为“数据”。

接下来，我需要根据[data]表A列中的照片名称，将[Photo]表中的照片批量插入到[Data]表B列中...

p>

动画示例如下。

.... ..

这个其实三句代码就足以实现该功能了。

代码如下。

Sub InsertPicFromSheet()Dim rngData As Range, rngPicName As RangeFor Each rngData In Range("a2 ", Cells (Rows.Count, 1).End( 3))设置rngPicName= Sheets("Photo").Cells.Find(rngData.Value, , , xlWhole)' 使用 Find 方法精确匹配 Photos 表中的名称。 如果 rngPicName 为空则 rngPicName.Offset(0, 1).Copy rngData .Offset(0, 1)' 如果找到对应的名称则将照片复制并粘贴到目标位置 NextEnd Sub 

但是...

上面代码最大的问题是因为旧照片已经存在于数据表中而没有被删除。 当您重复运行该程序时，图像会累积。 为了解决这个问题，我们需要再添加两行代码。

代码将更改如下。

Sub InsertPicFromSheet()Dim shp 作为形状，rngData 作为范围，rngPicName 作为活动工作表中每个 shp 的范围。    Shapes'删除活动工作表中的原始照片If shp.Type = 13 then shp.DeleteNextFor Each rngData In Range("a2", Cells(Rows.Count, 1).End(3))Set rngPicName = Sheets(" Photo" ).Cells.Find(rngData.Value, , , xlWhole)' 使用 Find 方法精确匹配 Photo 表中的名称。   如果 rngPicName 为空，则 rngPicName.Offset(0, 1).Copy rngData.Offset( 0, 1)' 如果找到对如果选择相应的名称，请将照片复制并粘贴到目标位置。  NextEnd Sub

上面的代码使用了一种一刀切的方法来删除旧照片。

没什么...

对于有良好VBA基础的朋友来说，这段代码足以通过一些修改来处理大多数问题，但显然对于初学者来说不够友好...

例如...

1.照片的名称固定在数据表的A列中。 事实上，它可能不是A列。 我是对的。 。

2、照片放置位置固定在名称栏右移一栏的单元格。 当然，在现实生活中，情况可能并非如此。 我说的仍然是事实。

3. 在代码中，存储照片的工作表被固定到一个工作表（“照片”）中。 事实上，情况并非如此。 我很聪明...

4. 代码单元格大小未设置为与图像大小匹配。

代码将更改如下。

Sub InsertPicFromSheet2()&# 39;ExcelHome 学习和练习 VBA 编程：StarlightDim rngData As Range、rngWhere As Range、cll As RangeDim rngPicName As Range，参见rngPic 作为范围，rngPicPaste 作为 RangeDim shp 作为形状，sht 作为。  工作表，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)&# 39; intersect 语句阻止用户选择整列单元格，从而导致不必要的操作。   如果 rngData 为 Nothing，则 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))'偏移选择 Case 值 xCase "upper"Set rngWhere = rngData.Offset(-y, 0)Case "lower"Set rngWhere = rngData.Offset(y, 0)Case "left "Set rngWhere = rngData.Offset(0, -y )Case "Right"Set rngWhere = rngData.Offset(0, y)End SelectstrPicShtName = InputBox("请请输入保存图像的工作表的名称", , "照片")For Each sht In WorksheetsIf sht.Name = strPicShtName then bln = TrueNextIf bln  True then MsgBox "保存图像的工作表 Sheet not found : " & 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 方法精确匹配照片表中的名称 如果 rngPicName 没有任何内容，则设置 rngPicPaste = cll 。9; 设置要粘贴图像的单元格 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 & " 未找到对应的图片名称在非空单元格中。

上面的代码解决了前面提到的三个常见问题...

但是...三个问题还不够。 ..

在实际应用中仍然可能出现一些未解决的问题...

例如...

1 如何解决连接问题照片和数据源之间的关系？当数据源中的图像发生变化时，数据表中的图像也会自动变化吗？您还可以使用工作表激活事件或使用activesheet.chartobjects.add...

2. 如何调整图像大小以适合单元格，而不是调整单元格大小以适合图像？习推荐：Excel教程