可通过VBA宏实现Excel中图片按A列名称批量插入B列并关联命名：先准备路径与表结构，再用三类宏分别处理单格式、多格式匹配及反向生成清单，全程自动化。
如果您在Excel中需要将大量图片按特定规则批量命名，并自动插入到对应单元格中，同时让图片文件名与单元格内容保持关联，则可通过VBA宏实现自动化操作。以下是具体执行步骤：
一、准备图片与目标工作表结构
该方法要求所有待处理图片已统一存放于指定文件夹中，且Excel工作表中A列已预先填入期望的图片文件名（不含扩展名），B列将用于插入对应图片。宏运行时将按A列名称依次匹配同名图片并嵌入B列单元格内。
1、新建一个空白Excel工作簿，切换至“Sheet1”。
2、在A1开始向下输入期望的图片基础名称，例如：产品A、产品B、产品C。
3、确保所有图片以相同名称保存在本地固定路径下，如“D:\图片素材\”，格式统一为.jpg或.png。
4、确认Excel启用开发者选项并允许运行宏：点击“文件→选项→自定义功能区”，勾选“开发工具”；再进入“信任中心→宏设置”，选择“启用所有宏”（仅限可信环境）。
二、插入并编辑VBA宏代码
本方案通过Workbook级模块调用Shape对象插入图片，并利用Name属性绑定原始文件名，便于后续识别与管理。代码不依赖ActiveX控件，兼容Excel 2010及以上版本。
1、按Alt+F11打开VBA编辑器。
2、在左侧工程资源管理器中右键“ThisWorkbook”，选择“查看代码”。
3、粘贴以下完整代码：
Sub BatchInsertNamedPictures()
Dim ws As Worksheet, rng As Range, cell As Range
Dim picPath As String, fullName As String, shp As Shape
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
picPath = "D:\图片素材\" '请按实际路径修改
For Each cell In rng
If Not IsEmpty(cell.Value) Then
fullName = picPath & Trim(cell.Value) & ".jpg"
If Dir(fullName) "" Then
Set shp = ws.Shapes.AddPicture(fileName:=fullName, linkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=cell.Offset(0, 1).Left + 5, Top:=cell.Offset(0, 1).Top + 5, Width:=-1, Height:=-1)
shp.Name = "IMG_" & Trim(cell.Value)
shp.ScaleHeight 0.8, msoTrue
shp.ScaleWidth 0.8, msoTrue
End If
End If
Next cell
End Sub
三、适配多种图片格式的增强版宏
当图片格式不统一（含.jpg、.png、.bmp等）时，原宏需逐个判断扩展名是否存在。本方案采用循环检测机制，在同一路径下尝试多个后缀，提升容错率与适用性。
1、在VBA编辑器中新建模块：右键“Normal”或当前工程→插入→模块。
2、在新模块中粘贴以下代码：
Sub InsertPicByMultiExt()
Dim extArr As Variant, i As Long, found As Boolean
extArr = Array(".jpg", ".jpeg", ".png", ".bmp", ".gif")
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim picFolder As String: picFolder = "D:\图片素材\" '请按实际路径修改
Dim cell As Range
For Each cell In ws.Range("A1:A" & lastRow)
If Not IsEmpty(cell) Then
found = False
For i = LBound(extArr) To UBound(extArr)
If Dir(picFolder & Trim(cell.Value) & extArr(i)) "" Then
ws.Shapes.AddPicture picFolder & Trim(cell.Value) & extArr(i), msoFalse, msoTrue, cell.Offset(0, 1).Left + 5, cell.Offset(0, 1).Top + 5, -1, -1
ws.Shapes(ws.Shapes.Count).Name = "IMG_" & Trim(cell.Value) & extArr(i)
found = True: Exit For
End If
Next i
If Not found Then cell.Offset(0, 1).Value = "【未找到】"
End If
Next cell
End Sub
四、通过文件系统遍历反向生成命名清单
若仅有图片文件而无预先整理的名称列表，可先读取指定文件夹内全部图片文件名，自动写入A列并去除扩展名，再执行插入操作。此方式避免人工录入错误，适用于原始素材命名规范的场景。
1、在VBA编辑器中插入新模块，粘贴以下代码：
Sub ListFilesAndInsert()
Dim fso As Object, folder As Object, file As Object
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim picFolder As String: picFolder = "D:\图片素材\" '请按实际路径修改
Dim rowIdx As Long: rowIdx = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(picFolder)
For Each file In folder.Files
If LCase(fso.GetExtensionName(file.Name)) Like "jpg" Or LCase(fso.GetExtensionName(file.Name)) Like "png" Or LCase(fso.GetExtensionName(file.Name)) Like "bmp" Then
ws.Cells(rowIdx, 1).Value = fso.GetBaseName(file.Name)
rowIdx = rowIdx + 1
End If
Next file
Call BatchInsertNamedPictures '调用第一种插入宏
End Sub
