標題:
[發問]
EXCEL2010 批次匯入圖片,但不是用連結的方式
[打印本頁]
作者:
施建國
時間:
2015-6-22 23:57
標題:
EXCEL2010 批次匯入圖片,但不是用連結的方式
不好意思,之前有問過問題
我照著這裡的前輩修改,終於可以批次貼圖了
但後來發現是用連結的方式,我想要的是它是用複製貼上,然後符合儲存格大小
請問是要修改哪裡?謝謝各位前輩
Sub ChangeSize()
Dim Mypath As String, E As Range, MyPic As Object
Mypath = "C:\Users\Administrator\Desktop\掉漆\O13\"
With Sheets("O13")
.Pictures.Delete
For Each E In .Range("c3", .Range("c" & .Rows.Count).End(xlUp))
'For Each : 依序處裡集合的成員
'集合的成員: .Range("a2") 到 .Range("a" & .Rows.Count).End(xlUp))的儲存格
'(從最儲存格底部的列往到有資料的儲存格)
If Dir(Mypath & E & ".jpg") <> "" Then
Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
With MyPic
.ShapeRange.LockAspectRatio = msoFalse
.Left = E.Cells(1, 1).Left
.Top = E.Cells(1, 1).Top
.Width = E.Cells(1, 1).Width
.Height = E.Cells(1, 1).Height
End With
End If
Next
End With
End Sub
複製代碼
作者:
施建國
時間:
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
作者:
lpk187
時間:
2015-6-24 08:29
回復
2#
施建國
你上次這篇上，我的範例就有了啊！
http://forum.twbts.com/viewthread.php?tid=14275&rpid=78737&ordertype=0&page=1#pid78737
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If MsgBox("是否貼圖", 4) = vbNo Then Exit Sub
For Each shap In Sheets(Sh.Name).Shapes
shap.Delete
Next
For Each Rng In Sheets(Sh.Name).Range("C3", Range("c3").End(xlDown))
Pat = ThisWorkbook.Path & "\" & Sh.Name & "\" & Rng & ".jpg"
Sheets(Sh.Name).Shapes.AddPicture Pat, True, True, Rng.Left, Rng.Top, Rng.Width, Rng.Height
Next
End Sub
複製代碼
作者:
施建國
時間:
2015-6-26 16:04
回復
3#
lpk187
小弟試了幾天,還是弄不出來
謝謝大哥熱心回覆,請問我是哪裡做錯導致語法失敗呢??
[attach]21267[/attach]
[attach]21268[/attach]
[attach]21269[/attach]
之後搜索一些圖片的語法,找到Hsieh前輩寫的自己選擇檔案貼上
我再把那一整欄剪下貼上,也是一種辦法
Sub InputPictures()
Dim fs(), A As Range
If ActiveSheet.Shapes.Count > 0 Then
ActiveSheet.Shapes.SelectAll
Selection.Delete
End If
On Error GoTo 10
fs = Application.GetOpenFilename("所有圖片(*.jpg;*.png;*.tiff;*.bmp;*.gif),*.jpg;*.png;*.tiff;*.bmp;*.gif", , , , True)
For i = 1 To UBound(fs)
Set A = Cells(i, 1)
A = fs(i)
With 工作表1.Shapes.AddPicture(fs(i), True, True, A.Offset(, 1).Left, A.Top, A.Offset(, 1).Width, A.Offset(, 1).Height)
.Placement = xlMoveAndSize
End With
Next
10
End Sub
複製代碼
作者:
stillfish00
時間:
2015-6-26 16:45
回復
4#
施建國
1錯了
因為你之前圖片這樣放
C:\Users\Administrator\Desktop\掉漆\O13\001.jpg
那你Excel要放在
C:\Users\Administrator\Desktop\掉漆\你的Excel檔案
執行前要先選到 'O13' 這個工作表...
作者:
lpk187
時間:
2015-6-26 17:20
本帖最後由 lpk187 於 2015-6-26 17:27 編輯
回復
4#
施建國
我的程式碼放的位置如下圖，不管你的路徑在哪，只要如圖放就可以了
[attach]21271[/attach]
然後開啟工作簿後，只要點選工作表就會問你是否貼上圖片，圖片的路徑會去尋找
"這程式底下"
的"資料夾"，
因你當初說的，會和資料夾會和工作表同名，例如：O13工作表會去找O13的資料夾，圖片名稱則是依照C欄的名稱去尋找圖片，
作者:
lpk187
時間:
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檔
作者:
施建國
時間:
2015-6-27 04:16
回復
6#
lpk187
照著你的方式打,在半夜成功了
是我一開始沒選到工作表
後來又自作聰明改工作表的名字試試看
謝謝lpk187前輩熱心點出我的錯誤
感恩~~~~
作者:
施建國
時間:
2015-6-27 04:40
忘了說
lpk187前輩一開始寫的語法
已經完美的解決我的問題
是我自作聰明繞了一大圈
呵呵,想到就好笑
好在問題已經解決,可喜可賀
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
