在工作中经常会遇到需要在EXCEL中根据信息内容插入图片，少量的时候还可以手动插入，当遇到大量需要添加图片的时候手工根本是无法完成的，这时候就需要用到EXCEL的宏命令来完成了。

在工作中有些环境下是不需要直接显示图片的，在需要查看图片的时候才显示，直接插入到单元格批注中可以解决此需求，但是手动添加少数可以，大量就无法手动完成了，此宏可以解决此问题。

使用要求

• 需要图片均在一个目录下。
• 需要图片为jpg格式（最好尺寸一致，方便排版）。
• 图片名称需要与插入单元格内的信息一致。（根据需要自行制定规则）

使用方法

1. 打开EXCEL文件
2. 按住Alt + F11打开Visual Basic。
3. 在Visual Basic菜单中选“插入” -> “模块”。
4. 复制代码区域代码到其中。
5. 选中EXCEL中需要批量插入图片的单元格。
   例如：单元格内容为1，这个地方将插入1.jpg的图片
6. 在Visual Basic菜单中选“运行” -> “运行子过程/用户窗体”（快捷键F5）
7. 选择图片目录和指定图片显示长宽尺寸。

批量插入批注图片代码

Sub 插入图片()
    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 i = 1 To 100
    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
    Next
    Exit Sub
err:
    ActiveCell.ClearComments
    MsgBox "未找到同名的JPG图片！", 64, "提示"
End Sub