按名称查询图片，几句代码就弄定-英雄云拓展知识分享

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

以下图：

一份工作簿有两张工作表。
寄存照片的工作表名为【照片】，需要插入图片的工作表名为【数据】。
现在需要针对【数据】表的A列的图片名称，将【照片】表的照片批量插入到【数据】表的B列中去……
示例动画以下：

……
实现这样的功能，其实3句代码就够了。
代码以下：
Sub InsertPicFromSheet()
Dim rngData As Range, rngPicName As Range
For 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)
'如果有找到对应的姓名，则将照片复制粘贴到目标位置
Next


End Sub

不过……

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

代码修改以下：
Sub InsertPicFromSheet()
Dim shp As Shape, rngData As Range, rngPicName As Range
For Each shp In ActiveSheet.Shapes
'删除活开工作表原有照片
If shp.Type = 13 Then shp.Delete
Next
For 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)
'如果有找到对应的姓名，则将照片复制粘贴到目标位置
Next


End Sub

以上代码使用一刀切的方式删除旧有的图片。
2不过……
虽然这段代码对VBA基础良好的朋友来讲，略微修改下，已足够应对大部份的问题，但是，对小白而言，明显不够友好……
比如说……
1、照片的姓名固定在数据表的A列，实际情况，极可能不是A列，我说的对。
2、放置照片的位置固定于姓名列向右移动1列的单元格，实际情况，固然也极可能不是这样，我说的还是对。
3、代码中将贮存照片的工作表固定设置为sheets(“照片”)，实际情况，肯定极可能不是这样，我英明……
4、代码未设置单元格的大小以适应图片的大小，我……

图片

代码修改以下：
Sub InsertPicFromSheet2()
'VBA编程学习与实践 by:看见星光
Dim rngData As Range, rngWhere As Range, cll As Range
Dim rngPicName As Range, rngPic As Range, rngPicPaste As Range
Dim shp As Shape, sht As Worksheet, bln As Boolean
Dim strWhere As String, strPicName As String, strPicShtName As String
Dim x, y As Long, lngYesCount As Long, lngNoCount As Long
'On Error Resume Next
Set rngData = Application.InputBox("请选择应插入图片名称的单元格区域", Type:=8)
'用户选择需要插入图片的名称所在单元格范围
Set rngData = Intersect(rngData.Parent.UsedRange, rngData)
'intersect语句避免用户选择整列单元格，造成无谓运算的情况
If rngData Is Nothing Then MsgBox "选择的单元格范围不存在数据！": Exit Sub
strWhere = InputBox("请输入放置图片偏移的位置，例如上1、下1、左1、右1", , "右1")
'用户输入图片相对单元格的偏移位置
If Len(strWhere) = 0 Then Exit Sub
x = Left(strWhere, 1)
'偏移的方向
If InStr("上下左右", x) = 0 Then MsgBox "你未输入偏移方位。": Exit Sub
y = Val(Mid(strWhere, 2))
'偏移的值
Select Case x
Case "上"
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 Select
strPicShtName = InputBox("请输入寄存图片的工作表名称", , "照片")
For Each sht In Worksheets
If sht.Name = strPicShtName Then bln = True
Next
If bln <> True Then MsgBox "未找到保存图片的工作表：" & strPicShtName & vbCrLf & "程序退出。": Exit Sub
Application.ScreenUpdating = False
rngData.Parent.Select
For Each shp In ActiveSheet.Shapes
'如果旧图片寄存在目标图片寄存范围则删除
If Not Intersect(rngWhere, shp.TopLeftCell) Is Nothing Then shp.Delete
Next
x = rngWhere.Row - rngData.Row
y = 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 Then
Set rngPicPaste = cll.Offset(x, y)
'粘贴图片的单元格
Set rngPic = rngPicName.Offset(0, 1)
'保存图片的单元格
lngYesCount = lngYesCount + 1
'累加找到结果的个数
If lngYesCount = 1 Then
'设置放置图片单元格的行高和列宽，以适应图片的大小
rngPicPaste.RowHeight = rngPic.RowHeight
rngPicPaste.ColumnWidth = rngPic.ColumnWidth
End If
rngPicName.Offset(0, 1).Copy rngPicPaste
'如果有找到对应的姓名，则将照片复制粘贴到目标位置
Else
lngNoCount = lngNoCount + 1
'累加未找到结果的个数
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "共处理成功" & lngYesCount & "个对象，另有" & lngNoCount & "个非空单元格未找到对应的图片名称。"
End Sub

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

然……3不过……
还是有一些实际利用中可能出现的问题未解决……
比如说……
1、如何解决图片和数据源的联动性？当数据源图片更改的时候，数据表的图片也自动更改？嗯，除重新运行程序，也能够使用工作表的激活事件，或是使用activesheet.chartobjects.add……
2、如何设置图片的大小适应单元格，而不是调剂单元格的大小适应图片？
……

有关图片处理的代码，我们后期再继续分享，请记得延续关心公众号【VBA编程学习与实践】哦……

选择英雄云的云表单=选择更智能的Excel

在现代企业管理中，数据的高效管理和处理至关重要。随着信息技术的不断发展，英雄云的云表单已经成为了提高数据录入、管理和分析效率的不可或缺的工具。让我们来深入探讨英雄云-云表单的几大优势。

基础字段：多样性满足业务需求

英雄云的云表单中包括了各种基础字段，如单行文本、多行文本、数字输入框、单选框、复选框、下拉框、下拉复选框、日期时间、分割线等。这些字段的多样性使用户可以根据具体的业务需求，轻松进行文本、数据和时间信息的录入或修改。例如，您可以使用单行文本字段录入员工姓名、产品型号等，或者使用下拉框进行多选，根据不同情况选择更加方便的字段类型。

高级字段：提升工作效率

英雄云的云表单还提供了高级字段，如地址、图片、附件、手写签名、手机、子表、关联数据、关联查询以及流水号。这些高级字段在基础字段的基础上升级，可帮助用户完成一些琐碎的工作。例如，使用地址字段可以避免逐字打字，而流水号字段可以自动生成规律性的编号，非常适用于合同编号生成等场景。

部门成员字段：精确管理与通讯录的关联

英雄云的部门成员字段允许企业对各个部门的成员进行精确管理。用户可以通过部门成员字段获取通讯录中的部门成员信息，应用于记录报销人、报销部门等场景。这些成员字段还细分为成员单选和成员多选，可根据具体需求在通讯录中选择一个或多个成员。

聚合表：数据处理更智能

英雄云的聚合表功能用于对已存在的表单数据进行聚合计算，从而得到一张聚合表，后续其他表单可调用聚合表进行数据联动、关联查询和关联数据等操作完成数据处理。这一功能可应用于多种场景，如进销存管理、财务管理和门店零售管理等，帮助企业完成数据处理，提高工作效率。

表单权限设置：灵活管理数据访问

英雄云的表单权限设置允许用户根据企业的具体需求管理表单的访问和操作权限。用户可以根据系统权限或自定义权限对不同成员或团队进行权限设置，以确保数据的安全和合规性。这一功能使企业能够根据变化的业务需求和团队结构，实时调整权限设置。

自定义打印模板：文档输出更便捷

英雄云的云表单支持自定义打印模板，可将表单数据转换为可打印的Word文档。用户可以根据自己的需求进行排版和编辑，将产品规格说明书等文档轻松生成。这一功能提供了一种标准化的文档输出方式，简化了信息整理的过程。

综合来看，选择英雄云的云表单意味着选择更智能、更灵活、更高效的数据管理工具。无论是提高工作效率，精确管理数据，还是实现数据处理，英雄云的云表单都能满足您的多样化需求，助力您的业务发展。

如果您正在寻找一款强大的云表单工具，不妨考虑英雄云，它将为您带来更多的便捷和智能，助您事半功倍。

免责声明：

本网址（www.yingxiongyun.com）发布的材料主要源于独立创作和网友匿名投稿。此处提供的所有信息仅供参考之用。我们致力于提供准确且可信的信息，但不对材料的完整性或真实性作出任何保证。用户应自行验证相关信息的正确性，并对其决策承担全部责任。对于由于信息的错误、不准确或遗漏所造成的任何损失，本网址不承担任何法律责任。本网站所展示的所有内容，如文字、图像、标志、音频、视频、软件和程序等的版权均属于原创作者。如果任何组织或个人认为网站内容可能侵犯其知识产权，或包含不准确之处，请即刻联系我们进行相应处理。