批量插入图片到Excel单元格批注

1、右键工作表，点查看代码

2、插入模板，在模块中，复制以下代码，单击运行亦或增加宏按钮Sub 批量插入批注图片() '-幻腾寂埒---------------------------------------------------------------------- '自定义数据类型 Dim ImgFileFormat, FirstAddress As String Dim Pic As Variant, Pic_name As String, Sizes As String Dim Choose_rng, rng As Range Dim i As Integer Dim C As Range '选择需要插入区域 Set Choose_rng = Application.InputBox("选择需要插入的单元格或单元格区域", Type:=8) If WorksheetFunction.CountA(Choose_rng) = 0 Then MsgBox "选择单元格区域为空": Exit Sub '选择需要插入的图片及自定义图片的高度与宽度 ImgFileFormat = "Image files (*.bmp;*.gif;*.tif;*.jpg;*.jpeg)," & "*.bmp;*.gif;*.tif;*.jpg;*.jpeg" '指定图片格式 Pic = Application.GetOpenFilename(ImgFileFormat, , "选择多张图片", , True) '打开一个图片选择对话框 If VBA.TypeName(Pic) = "Boolean" Then MsgBox "没有选择文件": Exit Sub End IfStar: Sizes = Application.InputBox("请指定图片的高度与宽度，中间用半角逗号隔开" & Chr(10) & "例如“30,260”或者“80,100”", "指定批注大小", "100,120", , , , , 2) If InStr(Replace(Sizes, ", ", ","), ",") = 0 Then GoTo Star '如果没有输入","则返回重新输入 Application.ScreenUpdating = False Application.DisplayAlerts = False For i = 1 To UBound(Pic) '获取图片名字 Pic_name = StrReverse(Mid(StrReverse(Pic(i)), WorksheetFunction.Find(".", StrReverse(Pic(i))) + 1, WorksheetFunction.Find("\", StrReverse(Pic(i))) - 1 - WorksheetFunction.Find(".", StrReverse(Pic(i))))) '添加图片批注 With Choose_rng Set C = .Find(Pic_name, LookIn:=xlValues) If Not C Is Nothing Then FirstAddress = C.Address Do C.ClearComments '清除原有批注 With C '引用当前单元格 .AddComment '添加批注 .Comment.Visible = True .Comment.Shape.Fill.UserPicture Pic(i) '设置普通填充 .Comment.Shape.Select True '选择批注 .Comment.Shape.Height = Split(Replace(Sizes, ", ", ","), ",")(0) '自定义高度 .Comment.Shape.Width = Split(Replace(Sizes, ", ", ","), ",")(1) '自定义宽度 .Comment.Text Text:="" '用空格作为批注内容 .Comment.Visible = False '不可见 End With Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With Next i Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "插入批注图片完成"End Sub

3、选择需要插入的单元格区域（范围，内容和图片名称匹配）

4、选择需要插入的图片

5、设置批注图片的大小

6、完成批量插入。