在工作中经常会遇到需要在EXCEL中根据信息内容插入图片,少量的时候还可以手动插入,当遇到大量需要添加图片的时候手工根本是无法完成的,这时候就需要用到EXCEL的宏命令来完成了。
之前的EXCEL批量插入图片要求文件和图片必须在一个目录中,使用中会有诸多不便,此版本不再要求EXCEL文件必须跟图片在一个目录中了,手动选择图片目录即可。
使用要求
- 需要图片均在一个目录下。
- 需要图片为jpg格式(最好尺寸一致,方便排版)。
- 图片名称需要与插入单元格内的信息一致。(根据需要自行制定规则)
使用方法
- 打开EXCEL文件
- 按住Alt + F11打开Visual Basic。
- 在Visual Basic菜单中选“插入” -> “模块”。
- 复制代码区域代码到其中。
- 选中EXCEL中需要批量插入图片的单元格。
例如:单元格内容为1,这个地方将插入1.jpg的图片 - 在Visual Basic菜单中选“运行” -> “运行子过程/用户窗体”(快捷键F5)
- 选择图片目录和指定图片显示长宽尺寸。
批量插入图片代码
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