返回列表 上一主題 發帖

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

施建國

帖子
10 
主題
2 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 SP1 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
註冊時間
2015-6-12 
最後登錄
2023-7-14 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-6-12 02:07 | 只看該作者

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

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

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

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



收藏 分享

施建國

帖子
10 
主題
2 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 SP1 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
註冊時間
2015-6-12 
最後登錄
2023-7-14 
2#
發表於 2015-6-12 02:12 | 只看該作者
小弟忘了說
當我選到其他車站也是一樣自己從相對應的資料夾把照片存到儲存格,且符合儲存格大小
不是只有O13一個車站喔!!

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 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
複製代碼

TOP

施建國

帖子
10 
主題
2 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 SP1 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
註冊時間
2015-6-12 
最後登錄
2023-7-14 
4#
發表於 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就都可以貼上,看來....我要學習的還很多...

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
5#
發表於 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

TOP

施建國

帖子
10 
主題
2 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 SP1 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
註冊時間
2015-6-12 
最後登錄
2023-7-14 
6#
發表於 2015-6-14 01:44 | 只看該作者
回復 5# lpk187


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

TOP

        靜思自在 : 君子立恆志，小人恆立志。
返回列表 上一主題