求助.如何在一個300多筆的圖檔案夾內找2張圖>"< - Excel程式區

[發問] 求助.如何在一個300多筆的圖檔案夾內找2張圖>"<

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

1^# 跳轉到 »

發表於 2019-8-3 11:00 | 顯示全部帖子

1) 看是3張圖???
2) 要學會使用上傳附檔, 方便別人下載

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