救助，excel 批量如何插入图片

效果：
正常学术交流所录制的GIF，还请度娘不要删除

得得得，再发一次，系统再删我就爱莫能助了
VBA代码：
Sub 图片匹配()
Dim a As FileDialog
Dim b As String
Dim c As Range
Dim d As Range
Dim e As Range
Dim f As String
Dim g As String
Dim h As String
Dim i As Range
Dim j As String
'选择图片文件夹
Set a = Application.FileDialog(msoFileDialogFolderPicker)
With a
.Title = "请选择图片所在文件夹"
If .Show <> -1 Then Exit Sub
b = .SelectedItems(1) & "\"
End With
'选择名称区域
On Error Resume Next
Set c = Application.InputBox("请选择名称所在区域（单列）", "选择名称区域", Type:=8)
On Error GoTo 0
If c Is Nothing Then Exit Sub
'选择图片放置区域
On Error Resume Next
Set d = Application.InputBox("请选择图片放置区域（单列，与名称区域行数相同）", "选择图片区域", Type:=8)
On Error GoTo 0
If d Is Nothing Then Exit Sub
'检查区域是否匹配
If c.Rows.Count <> d.Rows.Count Then
MsgBox "名称区域与图片区域行数不一致！", vbCritical
Exit Sub
End If
'遍历名称区域并插入图片
Application.ScreenUpdating = False
For Each e In c
If e.Value <> "" Then
'检查是否存在匹配的图片
j = Dir(b & e.Value & ".*")
If j <> "" Then
f = b & j
Set i = d.Cells(e.Row - c.Row + 1, 1)
' 删除原有图片
On Error Resume Next
i.Parent.Pictures("Pic_" & e.Value).Delete
On Error GoTo 0
' 插入图片并调整大小
With i.Parent.Pictures.Insert(f)
.Name = "Pic_" & e.Value
.ShapeRange.LockAspectRatio = msoFalse
.Top = i.Top + 1
.Left = i.Left + 1
.Width = i.Width - 2
.Height = i.Height - 2
.Placement = xlMoveAndSize
End With
End If
End If
Next e
Application.ScreenUpdating = True
MsgBox "图片插入完成！", vbInformation
End Su
执行程序按部就班操作即可