[發問] 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

複製代碼

施建國

小學生 Rank: 1

帖子: 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

施建國

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: WIN7 SP1
軟體版本: Office 2010
閱讀權限: 10
性別: 男
註冊時間: 2015-6-12
最後登錄: 2023-7-14

3^#

發表於 2015-6-26 16:04 | 顯示全部帖子

回復 3# lpk187

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

之後搜索一些圖片的語法,找到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