EXCEL批量插入图片(自定义图片路径)

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

之前的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 mytest()
  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
          ActiveSheet.Shapes.AddShape(msoShapeRectangle, (cell.Left + 2.5), (cell.Top + 2), (cell.Width - 5), (cell.Height - 4)).Fill.UserPicture pics
           cell.Offset(1, 0).Select
        End If
    Next
    Next
    Exit Sub
err:
    ActiveCell.ClearComments
    MsgBox "未找到同名的JPG图片!", 64, "提示"
End Sub
张维龙
张维龙
一朝年华,一夕梦想!