Sub 插人圖片()
Dim i%, P$, N$(3), xR As Range, xS, Shp As Shape
'路徑與資料夾檢測
P = ThisWorkbook.Path & "\客戶名稱圖檔"
If Dir(P, vbDirectory) = "" Then MsgBox "〔客戶名稱圖檔〕路徑錯誤或資料夾不存在! ": Exit Sub
For Each xR In [A3:C3]
If xR = "" Then MsgBox xR(0) & "未輸入! ": Exit Sub
If xR(0) <> "編號" Then P = P & "\" & xR Else N(0) = xR
If Dir(P, vbDirectory) = "" Then MsgBox "〔" & xR(0) & "〕路徑錯誤或資料夾不存在! ": Exit Sub
Next
'圖片檔案檢測
For i = 1 To 3
N(i) = N(0) & -i & ".jpg"
If Dir(P & "\" & N(i)) = "" Then MsgBox "找不到〔" & N(i) & "〕圖片檔案! ": Exit Sub
Next i
'載入圖檔並調整大小及位置
xS = Array("A11", "E11", "I11")
For i = 1 To 3
Set xR = Range(xS(i - 1)).Resize(9, 4) '圖片放置的範圍
Set Shp = ActiveSheet.Shapes.AddPicture(P & "\" & N(i), 0, 1, xR.Left, xR.Top, -1, -1)
If Shp.Height > xR.Height Then Shp.Height = xR.Height - 2 '調整圖片高度
If Shp.Width > xR.Width Then Shp.Width = xR.Width - 2 '調整圖片寬度
Shp.Top = xR.Top + (xR.Height - Shp.Height) / 2 '調整圖片上邊界(上下置中)
Shp.Left = xR.Left + (xR.Width - Shp.Width) / 2 '調整圖片左邊界(左右置中)
'Kill P & "\" & N(i) '刪除圖片檔案
Next i
End Sub
