VBA插入圖片隨文件保存(非引用方式)
1.1. 需求分析
接收到xxx公司項目正在使用的Excel自動生成報告的宏,可以看出,大致就是把測試截圖全自動插入到報告文件中梢莽。
1.1.1. 已知問題
生成的報告文件有一個最大的問題就是當(dāng)目錄下的測試截圖被刪除時嗓袱,測試報告當(dāng)中的圖片就會顯示為空, 這顯然不是我們想要的效果。
查看宏代碼得知Pictures.Insert只是引用了路徑下的圖片胸蛛,圖片不能隨文件一起保存污茵,所以要解決這個問題。
Workbooks("" & Filename & "").Activate
Sheets("測試截圖").Select
Range("A8:R27").Select
file = Dir(ThisWorkbook.Path & "\" & zhanMing & "\測試截圖\整體覆蓋RxLevel.*")
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & zhanMing & "\測試截圖\" & file & "").Select 'Pictures.Insert方法葬项,因為在文檔中只存儲圖片的鏈接信息泞当,圖片不能隨文件一起保存
Selection.ShapeRange.LockAspectRatio = msoFalse
' Selection.ShapeRange.IncrementLeft -10
' Selection.ShapeRange.IncrementTop -10
Selection.ShapeRange.Height = 285
Selection.ShapeRange.Width = 485
1.2. 解決方案
使用Shapes.AddPicture 方法來保存文件
語法:
Shapes.AddPicture( Filename , LinkToFile , SaveWithDocument , Left , Top , Width , Height )
示例
This example adds a picture created from the file Music.bmp to myDocument.
Set myDocument = Worksheets(1)
myDocument.Shapes.AddPicture("c:\microsoft office\clipart\music.bmp", True, True, 100, 100, 70, 70)
1.2.1. 代碼的修改
1.新建一個子過程:
Sub InsertPicture(path As String, ran As Range)
'Path為文件路徑
'ran為要插入的單元格區(qū)域
Set myDocument = ActiveSheet
myDocument.Shapes.AddPicture(path, True, True, ran.Left, ran.Top, ran.Width, ran.Height).Placement = xlMoveAndSize
End Sub
2.把原宏中所有類似的代碼都改為以下格式
'原始代碼示例
Range("C14:D14").Select
file = Dir(ThisWorkbook.Path & "\" & zhanMing & "\現(xiàn)場照片\天線側(cè)面照片_第2小區(qū).*")
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & zhanMing & "\現(xiàn)場照片\" & file & "").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 170
Selection.ShapeRange.Width = 285
'修改后示例
file = Dir(ThisWorkbook.path & "\" & zhanMing & "\現(xiàn)場照片\天線側(cè)面照片_第2小區(qū).*")
Call InsertPicture(ThisWorkbook.path & "\" & zhanMing & "\現(xiàn)場照片\" & file & "", Range("C14:D14"))
3.測試后生成的文件大小比原來的文件大了好多,里面的圖片也真正保存到Excel文件中了民珍。