[發問] EXCEL2010 想批次匯入圖片

施建國

小弟最近工作上遇到一個問題
每個車站掉漆照片約1.2百張,有6個車站
照片檔案我已經依照時間排好為001.002.003.........這樣下去

VBA要如何寫出批次貼上???
如圖,當我選到O13這車站,會自己從O13資料夾把照片存到儲存格,且符合儲存格大小
從C3開始一直貼完

謝謝高手前輩指教,我看了一些類似的還是沒辦法領悟

施建國

小弟忘了說
當我選到其他車站也是一樣自己從相對應的資料夾把照片存到儲存格,且符合儲存格大小
不是只有O13一個車站喔!!

lpk187

回復 2# 施建國

1.下面程式碼需貼到ThisWorkbook中。
2.必須要在C欄貼圖處鍵入圖片名稱，圖片名稱不用加上副檔名，圖片的副檔名在程式中設定為Jpg格式，若不是的話請自行更改。
3.圖片名稱假若是純數字，在C欄記得設定為文字格式
4.圖片的資料夾必須在此檔案的資料夾中建立

1. Private Sub Workbook_SheetActivate(ByVal Sh As Object)
   
2. If MsgBox("是否貼圖", 4) = vbNo Then Exit Sub
   
3. For Each shap In Sheets(Sh.Name).Shapes
   
4.     shap.Delete
   
5. Next
   
6. For Each Rng In Sheets(Sh.Name).Range("C3", Range("c3").End(xlDown))
   
7.     Pat = ThisWorkbook.Path & "\" & Sh.Name & "\" & Rng & ".jpg"
   
8.     Sheets(Sh.Name).Shapes.AddPicture Pat, True, True, Rng.Left, Rng.Top, Rng.Width, Rng.Height
   
9. Next
   
10. End Sub

複製代碼

施建國

回復 3# lpk187

謝謝這位大哥熱心教導,不過小弟真的還是試不成功,可能我要再慢慢體會
我用另一位大哥寫的,稍作修改,成功的符合我要求

還是謝謝你的熱心,尤其你的解說讓不懂得語法的我也感到你的貼心
謝謝,最後附上我的程式碼

1. Sub ChangeSize()
   
2.     Dim Mypath As String, E As Range, MyPic As Object
   
3.     Mypath = "C:\Users\Administrator\Desktop\掉漆\O13\"
   
4.     With Sheets("O13")
   
5.         .Pictures.Delete
   
6.         For Each E In .Range("c3", .Range("c" & .Rows.Count).End(xlUp))
   
7.         'For Each  : 依序處裡集合的成員
   
8.         '集合的成員: .Range("a2") 到 .Range("a" & .Rows.Count).End(xlUp))的儲存格
   
9.                                      '(從最儲存格底部的列往到有資料的儲存格)
   
10.             If Dir(Mypath & E & ".jpg") <> "" Then
    
11.                 Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
    
12.                 With MyPic
    
13.                     .ShapeRange.LockAspectRatio = msoFalse
    
14.                     .Left = E.Cells(1, 1).Left
    
15.                     .Top = E.Cells(1, 1).Top
    
16.                     .Width = E.Cells(1, 1).Width
    
17.                     .Height = E.Cells(1, 1).Height
    
18.                 End With
    
19.             End If
    
20.         Next
    
21.     End With
    
22. End Sub

複製代碼

不知道為何圖片如果從001-102,只有100.101.102圖片貼得上
檔名從101-202就都可以貼上,看來....我要學習的還很多...

lpk187

回復 4# 施建國

不知道為何圖片如果從001-102,只有100.101.102圖片貼得上
檔名從101-202就都可以貼上,看來....我要學習的還很多...

這裡的001~099要變成文字，否則程式讀取後前面的0都會不見，變成1~99了
可以強制設為文字，其方法是在數量前加上單引號  '   就會變成文字了，例如 '001

施建國

回復 5# lpk187


謝謝大哥
又教我一招,這論壇真的都是好人
我在別的論壇都沒人理我
更過分的還有人私信,說2000元就幫我做
真的是....