当鼠标滑过单元格时,Excel就会自动显示图片……
这么做有什么好处呢?当鼠标滑过单元格时,Excel就会自动显示图片了,很实用,看起来也很酷~
实际效果如下图所示▼
、

Sub AddCommentPic()
Dim arr, i&, k&, n&, b As Boolean
Dim strPicName$, strPicPath$, strFdPath$
Dim rngData As Range, rngEach As Range
'On Error Resume Next
'用户选择图片所在的文件夹
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then strFdPath = .SelectedItems(1) Else: Exit Sub
End With
If Right(strFdPath, 1) <> '\' Then strFdPath = strFdPath & '\'
Set rngData = Application.InputBox('请选择需要插入图片到批注中的单元格区域', Type:=8)
'用户选择需要插入图片到批注中的单元格或区域
If rngData.Count = 0 Then Exit Sub
Set rngData = Intersect(rngData.Parent.UsedRange, rngData)
'intersect语句避免用户选择整列单元格,造成无谓运算的情况
If rngData Is Nothing Then MsgBox '选择单元格不能全为空。': Exit Sub
arr = Array('.jpg', '.jpeg', '.bmp', '.png', '.gif')
'用数组变量记录五种文件格式
Application.ScreenUpdating = False
For Each rngEach In rngData
'遍历选择区域的每一个单元格
If Not rngEach.Comment Is Nothing Then rngEach.Comment.Delete '删除旧的批注
strPicName = rngEach.Text '图片名称
If Len(strPicName) Then '如果单元格存在值
strPicPath = strFdPath & strPicName '图片路径
b = False 'pd变量标记是否找到相关图片
For i = 0 To UBound(arr)
'由于不确定用户的图片格式,因此遍历图片格式
If Len(Dir(strPicPath & arr(i))) Then
'如果存在相关文件
rngEach.AddComment '增加批注
With rngEach.Comment
.Visible = True '批注可见
.Text Text:=''
.Shape.Select True '选中批注图形
Selection.ShapeRange.Fill.UserPicture strPicPath & arr(i)
'插入图片到批注中
.Shape.Height = 150 '图形的高度,可以根据需要自己调整
.Shape.Width = 150 '图形的宽度,可以根据需要自己调整
.Visible = False '取消显示
End With
b = True '标记找到结果
n = n + 1 '累加找到结果的个数
Exit For '找到结果后就可以退出文件格式循环
End If
Next
If b = False Then k = k + 1 '如果没找到图片累加个数
End If
Next
MsgBox '共处理成功' & n & '个图片,另有' & k & '个非空单元格未找到对应的图片。'
Application.ScreenUpdating = True
End Sub
小贴士▼
3)代码中使用了intersect语句交叉选取已使用的单元格区域。
Set rngData = Intersect(rngData.Parent.UsedRange, rngData)
用户可以选择整列(比如整个A列)或多列单元格区域运行代码,而不用担心因为运算量过大,造成程序假死的情况。
4)代码导入的图片格式支持五种常见的类型
'.jpg', '.jpeg', '.bmp', '.png', '.gif'
.Shape.Height = 150 \'图形的高度,可以根据需要自己调整.Shape.Width = 150 \'图形的宽度,可以根据需要自己调整
赞 (0)