Board logo

標題: [發問] EXCEL2010 想批次匯入圖片 [打印本頁]
作者: 施建國    時間: 2015-6-12 02:07     標題: EXCEL2010 想批次匯入圖片

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

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

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



作者: 施建國    時間: 2015-6-12 02:12

小弟忘了說
當我選到其他車站也是一樣自己從相對應的資料夾把照片存到儲存格,且符合儲存格大小
不是只有O13一個車站喔!!
作者: lpk187    時間: 2015-6-12 11:10

本帖最後由 lpk187 於 2015-6-12 11:12 編輯

回復 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
複製代碼
作者: 施建國    時間: 2015-6-14 01:25

回復 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    時間: 2015-6-14 01:35

本帖最後由 lpk187 於 2015-6-14 01:36 編輯

回復 4# 施建國

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

這裡的001~099要變成文字，否則程式讀取後前面的0都會不見，變成1~99了
可以強制設為文字，其方法是在數量前加上單引號  '   就會變成文字了，例如 '001
作者: 施建國    時間: 2015-6-14 01:44

回復 5# lpk187


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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)