EXCEL批量插图的几种方法(含批注插图,VBA插图,以及用插图公式插入图片)

Excel应用过程中基本都会遇到根据货号插入对应图片的这种应用方式，而插入图片又分插到某个格子里和插到批注里两种方式。
这里例举了几种常用的插图方式，包括用VBA宏和用插图公式<TABLE><img src="">等方式。这里只列出图片在本地的情况，如果图片是网址形式的，存放在网络上的，可以参考这里https://www.bnxb.com/office/excel/27192.html

一、插图到单元格批注里面，鼠标移过去才显示图片
这种方式只能用宏来实现快速插图
宏如下：
给两个宏做参考，第一个宏比较智能可以选择图片文件夹，还可以设置图片大小。第二个宏就是设定格式直接执行就行，这个就要看运用环境来选择了

宏一：插入批注图片（可以选择存放文件夹，可以设定图片大小）
Sub pictopz()
    Dim cell As Range, fd, t, w As Byte, h As Byte
    Set fso = CreateObject("scripting.filesystemobject")
    Selection.ClearComments
    If Selection(1) = "" Then MsgBox "不能选择空白区。", 64, "提示": Exit Sub
    On Error GoTo err
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)    '允许用户选择一个文件夹
    If fd.Show = -1 Then
        t = fd.SelectedItems(1)    '选择之后就记录这个文件夹名称
    Else
        Exit Sub    '否则就退出程序
    End If
    w = Application.InputBox("您希望插入的图片显示多宽？" & Chr(10) & "Excel默认宽度为3.39，你可以输入1-15之间的数据。" & Chr(10) & "小于1时当做1计算。", "确认宽度", 3.39, , , , , 2)
    h = Application.InputBox("您希望插入的图片显示多高？" & Chr(10) & "Excel默认高度为2.09，你可以输入1-15之间的数据。" & Chr(10) & "小于1时当做1计算。", "确认高度", 2.09, , , , , 2)
    If w < 1 Or h < 1 Then w = 3.39: h = 2.09
    If w > 15 Or h > 15 Then MsgBox "原则上你的图片可以显示这么大，" & Chr(10) & "不过有必要吗？请重新输入1-15之间的数", 64, "提示": Exit Sub
    For Each cell In Selection
                       pics = t & "" & cell.Text & ".jpg"
                       If fso.fileexists(pics) Then
                 With cell.AddComment
                     .Visible = True
                     .Text Text:=""
                     .Shape.Select True
                     With Selection.ShapeRange
                         .Fill.UserPicture pics
                         .ScaleWidth w / 3, msoFalse, msoScaleFromTopLeft
                         .ScaleHeight h / 2.09, msoFalse, msoScaleFromTopLeft
                     End With
                     cell.Offset(1, 0).Select
                     .Visible = False
                 End With
        end if
    Next
    Exit Sub
err:
    ActiveCell.ClearComments
    MsgBox "未找到同名的JPG图片！", 64, "提示"
End Sub




宏二：插入批注图片（输入图片地址）
Sub add()
Set fso = CreateObject("scripting.filesystemobject")
For Each cell In Selection
pics = "请复制图片所在文件的地址粘贴在此处，替换本段文字" & cell.Value & ".jpg"
If fso.fileexists(pics) Then
With cell.AddComment
.Shape.Fill.UserPicture picturefile:=pics
.Shape.Height = 200
.Shape.Width = 150
End With
End If
Next cell
End Sub