我們今天分享的內容是按指定名稱和位置批量將圖片插入到Excel工作表中……這個問題後臺提問的朋友太多了，趕緊分享了事。
看個動畫先：
代碼如下：
Sub InsertPic()
'ExcelHome VBA編程學習與實踐 by:看見星光
Dim Arr, i&, k&, n&, pd&
Dim PicName$, PicPath$, FdPath$, shp As Shape
Dim Rng As Range, Cll As Range, Rg As Range, book$
'On Error Resume Next
'用戶選擇圖片所在的文件夾
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False '不允許多選
If .Show Then FdPath = .SelectedItems(1) Else: Exit Sub
End With
If Right(FdPath, 1) <> "\" Then FdPath = FdPath & "\"
Set Rng = Application.InputBox("請選擇圖片名稱所在的單元格區域", Type:=8)
'用戶選擇需要插入圖片的名稱所在單元格範圍
Set Rng = Intersect(Rng.Parent.UsedRange, Rng)
'intersect語句避免用戶選擇整列單元格，造成無謂運算的情況
If Rng Is Nothing Then MsgBox "選擇的單元格範圍不存在數據！": Exit Sub
book = InputBox("請輸入圖片偏移的位置，例如上1、下1、左1、右1", , "右1")
'用戶輸入圖片相對單元格的偏移位置。
If Len(book) = 0 Then Exit Sub
x = Left(book, 1) '偏移的方向
If InStr("上下左右", x) = 0 Then MsgBox "你未輸入偏移方位。": Exit Sub
y = Val(Mid(book, 2)) '偏移的尺寸
Select Case x
Case "上"
Set Rg = Rng.Offset(-y, 0)
Case "下"
Set Rg = Rng.Offset(y, 0)
Case "左"
Set Rg = Rng.Offset(0, -y)
Case "右"
Set Rg = Rng.Offset(0, y)
End Select
Application.ScreenUpdating = False
Rng.Parent.Select
For Each shp In ActiveSheet.Shapes '如果舊圖片存放在目標圖片存放範圍則刪除
If Not Intersect(Rg, shp.TopLeftCell) Is Nothing Then shp.Delete
Next
x = Rg.Row - Rng.Row: y = Rg.Column - Rng.Column
'偏移的座標
Arr = Array(".jpg", ".jpeg", ".bmp", ".png", ".gif")
'用數組變量記錄五種文件格式
For Each Cll In Rng
'遍歷選擇區域的每一個單元格
PicName = Cll.Text '圖片名稱
If Len(PicName) Then '如果單元格存在值
PicPath = FdPath & PicName '圖片路徑
pd = 0 'pd變量標記是否找到相關圖片
For i = 0 To UBound(Arr)
'由於不確定用戶的圖片格式，因此遍歷圖片格式
If Len(Dir(PicPath & Arr(i))) Then
'如果存在相關文件
ActiveSheet.Pictures.Insert(PicPath & Arr(i)).Select
'插入圖片並選中
With Selection
.ShapeRange.LockAspectRatio = msoFalse
'撤銷鎖定縱橫比
.Top = Cll.Offset(x, y).Top + 5
.Left = Cll.Offset(x, y).Left + 5
.Height = Cll.Offset(x, y).Height - 10 '圖片高度
.Width = Cll.Offset(x, y).Width - 10 '圖片寬度
End With
pd = 1 '標記找到結果
n = n + 1 '累加找到結果的個數
[a1].Select: Exit For '找到結果後就可以退出文件格式循環
End If
Next
If pd = 0 Then k = k + 1 '如果沒找到圖片累加個數
End If
Next
MsgBox "共處理成功" & n & "個圖片，另有" & k & "個非空單元格未找到對應的圖片。"
Application.ScreenUpdating = True
End Sub
代碼已有註釋，這兒就再說明一下運行過程。
首先，會讓用戶選擇存放圖片的文件夾。注意是選擇文件夾，不是選擇圖片；選擇文件夾後，看不到文件夾內的圖片是正常現象。
然後，選擇圖片名稱存放的單元格區域，可以選擇整列、多列、整行或多行，比如示例動畫中的B:D列，2:2行等。。
最後，設置圖片相對於圖片名稱所在的單元格便宜的位置；比如圖片名稱在B列，圖片放在C列，那就是向右偏移1列，即右1。上下左右代表了方向，數字代表偏移的量。
代碼繼續運行，先刪除存放於放置圖片單元格範圍的原圖片圖形（如何用代碼刪除指定位置的圖形圖片？這個問題也不要在後臺提問了），然後遍歷圖片名稱，根據偏移位置插入新圖片。
代碼運行結束後會告之用戶一共成功插入了多少張圖片，以及失敗了多少張：
小貼士：
1，該段小代碼支持一下圖片格式：
".jpg", ".jpeg", ".bmp", ".png", ".gif"
2，圖片的縱橫比是未鎖定的，如需鎖定，可以註釋掉下句代碼：
.ShapeRange.LockAspectRatio = msoFalse
3，圖片的行高和列寬是由放置圖片的單元格行高和列寬決定的。當然，您也可以把代碼稍微修改，設置固定的圖片行高和列寬，並由圖片的行高和列寬決定單元格的大小。
4，圖片的名稱必須和指定單元格範圍內的名稱一致，如果需要模糊匹配，使用DIR函數搭配通配符的方式即可。
5，還有什麼……想不起來了，就先醬紫吧，揮手致安~
嗯，以下是示例文件~.
https://pan.baidu.com/s/1ClgLjzXe0K9WOIPbxDPDhg#list/path=%2F
看完辛苦 轉發 關注 下哈，每天為你分享Excel技巧
閱讀更多 孫樹帥老師 的文章
