返回列表 上一主題 發帖

[發問] EXCEL2010 批次匯入圖片,但不是用連結的方式

施建國

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

[發問] EXCEL2010 批次匯入圖片,但不是用連結的方式

不好意思,之前有問過問題
我照著這裡的前輩修改,終於可以批次貼圖了
但後來發現是用連結的方式,我想要的是它是用複製貼上,然後符合儲存格大小

請問是要修改哪裡?謝謝各位前輩
  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
複製代碼
收藏 分享

施建國

帖子
10 
主題
2 
精華
0 
積分
11 
點名
0  
作業系統
WIN7 SP1 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
註冊時間
2015-6-12 
最後登錄
2023-7-14 
9#
發表於 2015-6-27 04:40 | 只看該作者
忘了說
lpk187前輩一開始寫的語法
已經完美的解決我的問題
是我自作聰明繞了一大圈
呵呵,想到就好笑
好在問題已經解決,可喜可賀

TOP

施建國

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


照著你的方式打,在半夜成功了
是我一開始沒選到工作表
後來又自作聰明改工作表的名字試試看

謝謝lpk187前輩熱心點出我的錯誤
感恩~~~~

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
7#
發表於 2015-6-26 17:36 | 只看該作者
本帖最後由 lpk187 於 2015-6-26 17:38 編輯

回復 4# 施建國


    主要的路徑都在這列
Pat = ThisWorkbook.Path & "\" & Sh.Name & "\" & Rng & ".jpg"
ThisWorkbook.Path==>本檔案所在的資料夾
Sh.Name==>是工作表也是資料夾名稱
Rng & ".jpg"==>因為我假設你的圖片副檔名都為JPG檔，而Rng則是C欄的圖片主要檔名，若你的圖片不是JPG檔請自行更改。
會產生錯誤主要是你檔案或圖片放錯地方了，或者是副檔名不是JPG檔

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2015-6-26 17:20 | 只看該作者
本帖最後由 lpk187 於 2015-6-26 17:27 編輯

回復 4# 施建國


   
我的程式碼放的位置如下圖，不管你的路徑在哪，只要如圖放就可以了

然後開啟工作簿後，只要點選工作表就會問你是否貼上圖片，圖片的路徑會去尋找"這程式底下"的"資料夾"，
因你當初說的，會和資料夾會和工作表同名，例如：O13工作表會去找O13的資料夾，圖片名稱則是依照C欄的名稱去尋找圖片，

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 2015-6-26 16:45 | 只看該作者
回復 4# 施建國
1錯了
    因為你之前圖片這樣放
    C:\Users\Administrator\Desktop\掉漆\O13\001.jpg

    那你Excel要放在
    C:\Users\Administrator\Desktop\掉漆\你的Excel檔案
    執行前要先選到 'O13' 這個工作表...
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

施建國

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


小弟試了幾天,還是弄不出來
謝謝大哥熱心回覆,請問我是哪裡做錯導致語法失敗呢??







之後搜索一些圖片的語法,找到Hsieh前輩寫的自己選擇檔案貼上
我再把那一整欄剪下貼上,也是一種辦法
  1. Sub InputPictures()
  2. Dim fs(), A As Range
  3. If ActiveSheet.Shapes.Count > 0 Then
  4. ActiveSheet.Shapes.SelectAll
  5. Selection.Delete
  6. End If
  7. On Error GoTo 10
  8. fs = Application.GetOpenFilename("所有圖片(*.jpg;*.png;*.tiff;*.bmp;*.gif),*.jpg;*.png;*.tiff;*.bmp;*.gif", , , , True)
  9. For i = 1 To UBound(fs)
  10. Set A = Cells(i, 1)
  11. A = fs(i)
  12. With 工作表1.Shapes.AddPicture(fs(i), True, True, A.Offset(, 1).Left, A.Top, A.Offset(, 1).Width, A.Offset(, 1).Height)
  13. .Placement = xlMoveAndSize
  14. End With
  15. Next
  16. 10
  17. End Sub
複製代碼

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 2015-6-24 08:29 | 只看該作者
回復 2# 施建國


   你上次這篇上，我的範例就有了啊！
http://forum.twbts.com/viewthread.php?tid=14275&rpid=78737&ordertype=0&page=1#pid78737
  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 
2#
發表於 2015-6-24 04:41 | 只看該作者
上網查到Shapes.AddPicture
但不知道如何取代

從已存在的檔案中建立圖片。傳回代表新圖片的 Shape 物件。
語法

ActiveSheet.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

參數

名稱 必要/選用 資料類型 描述
Filename 必要 String 要建立 OLE 物件的來源檔案。
LinkToFile 必要 MsoTriState 要連結的檔案。
SaveWithDocument 必要 MsoTriState 要與文件一同儲存的圖片。
Left 必要 Single 圖片的左上角位置 (以點為單位)，與文件左上角相對。
Top 必要 Single 圖片的左上角位置 (以點為單位)，與文件頂端相對。
Width 必要 Single 圖片的寬度 (以點為單位)。
Height 必要 Single 圖片的高度 (以點為單位)。

傳回值 Shape

TOP

        靜思自在 : 改變自己是自救，影響別人是救人。
返回列表 上一主題