专栏名称: Excel之家ExcelHome
excel技巧原创教程每日推送,excel表格职场模板干货仓库,图文/视频/动画等多种教学方式分享excel操作技巧教程/excel函数公式教程/excel数据透视表教程/excel图表教程/Word教程,助您轻松提高办公效率!
目录
相关文章推荐
完美Excel  ·  巧用COUNTA函数统计单元格数,但deep ... ·  昨天  
完美Excel  ·  使用deepseek在Excel用户窗体中生 ... ·  19 小时前  
完美Excel  ·  deepseek使用心得2:向deepsee ... ·  4 天前  
完美Excel  ·  使用deepseek自动合并工作簿 ·  6 天前  
完美Excel  ·  deepseep+Python实现自动合并E ... ·  3 天前  
51好读  ›  专栏  ›  Excel之家ExcelHome

VBA常用小代码:在批注中批量插入图片

Excel之家ExcelHome  · 公众号  · Excel  · 2025-02-14 07:45

正文

有个朋友在后台提了这样一个问题,能不能根据名称一键将图片批量插入到单元格的批注中去,酱紫的话,当鼠标划过单元格,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 '如果没找到图片累加个数







请到「今天看啥」查看全文