VBA / 使用Excel VBA插入圖檔

VBA / 使用Excel VBA插入圖檔

Post Views: 2,066

這個是在Line Excel VBA社群的問題

發問者提供了操作影片跟檔案，所以可以很好理解所遇到的問題

原始檔案利用VBA寫了兩個程序

 

檔案一開始就存在的圖檔可以刪除

後來新增的圖檔卻不能刪除

研究了一下

發現這是圖檔類型(MsoShapeType)的問題

程式碼是利用 Sheet.Pictures.Insert()方法插入的圖片

圖檔類型是msoLinkedPicture

但是檔案一開始就存在的圖片應該是在工作表透過插入/圖片的方式

這樣圖檔類型會是msoPicture

從名稱就可以看出差別

前者是連結圖檔而已，所以當圖檔改變名稱或位置時

工作表就會讀不到圖檔

單就無法刪除圖檔的問題，只需要多一個條件就可以了

原始程式碼只有判別 msoPicture

1
2
3
 
For Each a In ActiveSheet.Shapes
        If a.Type = msoPicture Then a.Delete
Next

 

增加另一個 msoLinkedPicture的條件

1
2
3
 
For Each a In ActiveSheet.Shapes
        If a.Type = msoPicture Or a.Type = msoLinkedPicture Then a.Delete
Next

 

但是比較好的方式是將匯入程式碼改為利用 Sheet.Shapes.AddPicture()

AddPicture (FileName、 LinkToFile、 SaveWithDocument、 Left、 Top、 Width、 Height)

而且這個方式也可以在參數設定時，設定成以連結方式讀取圖檔

原始程式碼

工作表的B欄儲存檔案名稱，而圖檔跟工作簿是放在同一個資料夾內

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
 
With Sheets("清冊")
	lRow = .[b65536].End(xlUp).Row
	For I = 2 To lRow
	On Error Resume Next
		'strFile = ThisWorkbook.Path & "\" & .Cells(i, 4) & ".jpg"
		strFile = ActiveWorkbook.Path & "\" & .Cells(I, 2) & ".jpg"
		Set oPic = .Pictures.Insert(strFile)
		With .Cells(I, 3)
			oPic.Top = .Top
			oPic.Left = .Left
			oPic.Width = 60
			oPic.Height = 70
		End With
		Set oPic = Nothing
	Next I
End With

 

修改後的程式碼

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
 
With Sheets("清冊")
        lRow = .[b65536].End(xlUp).Row
        For I = 2 To lRow
        On Error Resume Next
            'strFile = ThisWorkbook.Path & "\" & .Cells(i, 4) & ".jpg"
'            strFile = "C:\Users\trico\Pictures" & "\" & .Cells(I, 2) & ".jpg"
            strFile = ActiveWorkbook.Path & "\" & .Cells(I, 2) & ".jpg"
            Set oPic = .Shapes.AddPicture(strFile, msoFalse, msoTrue, Cells(I, 3).Left + 2, Cells(I, 3).Top + 1, 120, 70)
            Set oPic = Nothing
        Next I
End With

 

補充

當 LinkToFile 為msoFalse時， SaveWithDocument必須為msoTrue，插入的圖檔類型為 msoPicture

但是LinkToFile 為msoTrue時， SaveWithDocument無論是msoTrue或msoFalse，插入的圖檔類型都是 msoLinkedPicture

備註1

比較奇怪的點，同樣的圖片寬度設定，使用Shapes.AddPicture()插入的圖檔大小只有Pictures.Insert()的一半

所以在 Shapes.AddPicture()的寬度設定為Pictures.Insert()的2倍 (60→120)

不過後來發現在 Pictures.Insert()的寬度跟高度只要擇一設定就好了

現在的圖檔是會以高度等比例調整寬度，所以最終寬度其實不是60

備註2

Pictures.Insert()找不到官方的說明資料

找到的都是教學類或者論壇的使用範例

vba插入圖片問題

VBA help for a Macro (inserting picture from file)

Tags: