📘 Excel VBA 教程：批量根据单元格内容插入对应图片
🧩 场景介绍
你有一批产品编号或文件名（例如：2522968E4、123ABC 等），这些编号被列在 Excel 中的某一列中。你希望根据这些编号，在 Excel 中 自动插入对应的图片，图片保存在某个文件夹中，文件名与编号一一对应（如 2522968E4.jpg）。
这个教程将教你如何使用 VBA 一键完成这个工作。
🛠 准备工作
- 图片命名规则 确保所有图片的文件名与 Excel 单元格中的内容一致，并且是
.jpg格式，例如：2522968E4.jpg 123ABC.jpg - 将图片放入指定文件夹 比如放在：
C:UsersAdministratorDesktop 单品 - Excel 表格数据示意 比如 A 列如下所示：
A 2522968E4 123ABC TEST001
🧪 效果预览
运行宏后，Excel 会：
- 遍历你选中的每个单元格；
- 判断是否存在对应的
.jpg图片； - 若存在，则在该单元格位置插入图片；
- 若不存在，则跳过，不报错、不提示；
- 每次运行都会 先删除旧图片，再插入新图，避免重复叠加。
✅ VBA 代码（Sub AAA）
打开 VBA 编辑器（快捷键 Alt + F11），插入一个模块（插入 > 模块），然后粘贴以下代码：
Sub InsertPicturesAndFitToCell_WithMargin()
Dim TargetCell As Range
Dim ImgFolderPath As String
Dim ImgPath As String
Dim OldShape As Shape
Dim NewShape As Shape
Dim ImgExists As Boolean
' ===================================================================
'【修改为你的图片文件夹路径】ImgFolderPath = "C:UsersAdministratorDesktop 单品图 " ' <--- 修改这里
' ===================================================================
If Right(ImgFolderPath, 1) <> "" Then ImgFolderPath = ImgFolderPath & ""
' 限定选区为单元格
If TypeName(Selection) <> "Range" Then
MsgBox " 请先选择需要插入图片的单元格区域。", vbInformation, " 提示 "
Exit Sub
End If
Application.ScreenUpdating = False
' 支持的图片格式
Dim extensions() As Variant
extensions = Array(".jpg", ".jpeg", ".png", ".gif", ".bmp", ".tif")
' 遍历选区里的每一个单元格
For Each TargetCell In Selection
If Not IsEmpty(TargetCell.Value) Then
' 删除当前单元格内已存在的图片
For Each OldShape In TargetCell.Parent.Shapes
If Not Intersect(OldShape.TopLeftCell, TargetCell) Is Nothing And _
Not Intersect(OldShape.BottomRightCell, TargetCell) Is Nothing Then
OldShape.Delete
End If
Next OldShape
' 根据多种扩展名寻找对应图片
ImgExists = False
Dim ext As Variant
For Each ext In extensions
ImgPath = ImgFolderPath & TargetCell.Value & ext
If Dir(ImgPath) <> "" Then
ImgExists = True
Exit For
End If
Next ext
If ImgExists Then
' 插入图片
Set NewShape = TargetCell.Parent.Shapes.AddPicture( _
Filename:=ImgPath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=TargetCell.Left, _
Top:=TargetCell.Top, _
Width:=-1, _
Height:=-1)
With NewShape
.LockAspectRatio = msoTrue
' 设置边距（默认 5%）Dim marginW As Double, marginH As Double
marginW = TargetCell.Width * 0.05
marginH = TargetCell.Height * 0.05
' 计算可用的最大宽高
Dim maxW As Double, maxH As Double
maxW = TargetCell.Width - 2 * marginW
maxH = TargetCell.Height - 2 * marginH
' 按比例缩放到可用尺寸
If .Width / .Height > maxW / maxH Then
.Width = maxW
Else
.Height = maxH
End If
' 居中对齐
.Left = TargetCell.Left + (TargetCell.Width - .Width) / 2
.Top = TargetCell.Top + (TargetCell.Height - .Height) / 2
' 让图片随单元格移动 / 排序保持同步
.Placement = xlMoveAndSize
End With
Else
' 可选：在相邻单元格显示“图片未找到”提示
' TargetCell.Offset(0, 1).Value = " 图片未找到 "
End If
End If
Next TargetCell
Application.ScreenUpdating = True
MsgBox " 所有图片已插入并自动缩放！", vbInformation, " 完成 "
End Sub
🚀 如何使用？
- 回到 Excel 界面（Alt + F11 退出）
- 在表格中选择你想插入图片的单元格区域（如 A2:A10）
- 按下快捷键
Alt + F8，选择宏AAA，点击“运行”
💡 注意事项
On Error Resume Next：防止程序在找不到图片时报错；- 你可以根据需要修改图片路径
imgFolderPath； - 图片格式必须是
.jpg，否则程序找不到； - 若想支持
.png、.jpeg等格式，请做相应扩展； - 本代码插入的是带图片填充的矩形框，如果你希望插入原图，可以改为
Shapes.AddPicture。
✅ 拓展建议
你还可以：
- 将宏绑定到按钮，实现一键操作；
- 加上多格式支持；
- 插入时设置边框或阴影等样式美化图片；
- 将结果导出为 PDF 报表。
如果你希望我为你做一个配套的图文 Word/PDF 版教程，也可以告诉我，我可以帮你生成。
需要我进一步优化代码或添加功能吗？
正文完
