Excel技巧，一个嵌入图片的VBA代码!

Sub 嵌入图片()
Dim fldr As FileDialog
Dim wenjlj As String
Dim xlwenj As String
Dim tp As Collection
Dim nr As Long, wz As Long
Dim ws As Worksheet
Dim img As Picture
Dim filePath As String

' 设置工作表
Set ws = ThisWorkbook.Sheets(1) ' 假设操作的是第一个工作表
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Title = "请选择图片文件夹"
fldr.InitialFileName = ThisWorkbook.Path & "\"

' 弹出文件夹选择对话框
If fldr.Show = -1 Then
wenjlj = fldr.SelectedItems(1)
Else
MsgBox "未选择文件夹", vbExclamation
Exit Sub
End If

' 初始化Collection对象
Set tp = New Collection
xlwenj = Dir(wenjlj & "\*.jpg") ' 获取文件夹中的.jpg文件
Do While xlwenj <> ""
tp.Add wenjlj & "\" & xlwenj ' 将图片路径添加到Collection中
xlwenj = Dir()
Loop

' 遍历A列，匹配并插入图片
For nr = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For wz = 1 To tp.Count
filePath = tp(wz)
' 提取文件名（不包含路径）
Dim fileName As String
fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))

' 检查A列的值是否与文件名匹配
If InStr(1, fileName, ws.Cells(nr, 1).Value2) > 0 Then
' 插入图片到B列
Set img = ws.Pictures.Insert(filePath)
With img
.ShapeRange.LockAspectRatio = msoFalse
.Width = ws.Columns("B").Width
.Height = ws.Rows(nr).Height
.Top = ws.Cells(nr, 2).Top
.Left = ws.Cells(nr, 2).Left
End With
Exit For
End If
Next wz
Next nr

学习资料见知识星球。

以上就是今天要分享的技巧，你学会了吗？若有什么问题，欢迎在下方留言。

快来试试吧，小琥 my21ke007。获取 1000个免费 Excel模板福利​​​​！

更多技巧， www.excelbook.cn

欢迎 加入 零售创新 知识星球，知识星球主要以数据分析、报告分享、数据工具讨论为主；