欢迎大家来到IT世界,在知识的湖畔探索吧!
有个貌美如花的朋友在后台提了这样一个问题,能不能根据名称一键将图片批量插入到单元格的批注中去,酱紫的话,当鼠标划过单元格,Excel就会自动显示图片了,很酷很实用……
比如下面动态图所展示的这样:
实现代码如下:
Sub CommentPic()
‘ExcelHome VBA编程学习与实践 看见星光
Dim Arr, i&, k&, n&, pd&
Dim PicName$, PicPath$, FdPath$
Dim Rng As Range, Cll As Range
Application.ScreenUpdating = False
On Error Resume Next
‘
‘用户选择图片所在的文件夹
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False ‘不允许多选
If .Show Then FdPath = .SelectedItems(1) Else: Exit Sub
End With
If Right(FdPath, 1) <> “\” Then FdPath = FdPath & “\”
‘
Set Rng = Application.InputBox(“请选择需要插入图片到批注中的单元格区域”, Type:=8)
‘用户选择需要插入图片到批注中的单元格或区域
If Rng.Count = 0 Then Exit Sub
Set Rng = Intersect(Rng.Parent.UsedRange, Rng)
‘intersect语句避免用户选择整列单元格,造成无谓运算的情况
Arr = Array(“.jpg”, “.jpeg”, “.bmp”, “.png”, “.gif”)
‘用数组变量记录五种文件格式
‘
For Each Cll In Rng
‘遍历选择区域的每一个单元格
Cll.Comment.Delete ‘删除旧的批注
PicName = Cll.Text ‘图片名称
If Len(PicName) Then ‘如果单元格存在值
PicPath = FdPath & PicName ‘图片路径
pd = 0 ‘pd变量标记是否找到相关图片
For i = 0 To UBound(Arr)
‘由于不确定用户的图片格式,因此遍历图片格式
If Len(Dir(PicPath & Arr(i))) Then
‘如果存在相关文件
Cll.AddComment ‘增加批注
With Cll.Comment
.Visible = True ‘批注可见
.Text Text:=””
.Shape.Select True ‘选中批注图形
Selection.ShapeRange.Fill.UserPicture PicPath & Arr(i)
‘插入图片到批注中
.Shape.Height = 150 ‘图形的高度,可以根据需要自己调整
.Shape.Width = 150 ‘图形的宽度,可以根据需要自己调整
.Visible = False ‘取消显示
End With
pd = 1 ‘标记找到结果
n = n + 1 ‘累加找到结果的个数
Exit For ‘找到结果后就可以退出文件格式循环
End If
Next
If pd = 0 Then k = k + 1 ‘如果没找到图片累加个数
End If
Next
MsgBox “共处理成功” & n & “个图片,另有” & k & “个非空单元格未找到对应的图片。”
Application.ScreenUpdating = True
End Sub
小贴士:
1,代码运行后,首先弹出操作界面,要求用户选择图片所存放的文件夹,注意是选择文件夹,不是选择图片,双击打开文件夹后看不到图片是正常现象……。
2,图片的名称需要和单元格的值相匹配;小代码如果找不到单元格的值所对应的图片,会直接跳过,处理下一个单元格;代码运行结束后,会发出信息,告知一共处理成功了几个图片以及未成功几个非空单元格的图片。
3,代码中使用了intersect语句,Set Rng = Intersect(Rng.Parent.UsedRange, Rng),因此用户可以选择整列(比如整个A列)或多列单元格区域运行代码,而不用担心因为无谓的运算量过大,造成程序假死的情况。
4,代码导入的图片格式支持五种常见的类型,Arr = Array(“.jpg”, “.jpeg”, “.bmp”, “.png”, “.gif”)
5,批注图片的高度和宽度可以根据自身情况做调整,相关代码如下:
.Shape.Height = 150 ‘图形的高度,可以根据需要自己调整
.Shape.Width = 150 ‘图形的宽度,可以根据需要自己调整
图文作者:看见星光
免责声明:本站所有文章内容,图片,视频等均是来源于用户投稿和互联网及文摘转载整编而成,不代表本站观点,不承担相关法律责任。其著作权各归其原作者或其出版社所有。如发现本站有涉嫌抄袭侵权/违法违规的内容,侵犯到您的权益,请在线联系站长,一经查实,本站将立刻删除。 本文来自网络,若有侵权,请联系删除,如若转载,请注明出处:https://itzsg.com/95923.html