VBA插入圖片隨文件保存（非引用方式）

1.1. 需求分析

接收到xxx公司項(xiàng)目正在使用的Excel自動(dòng)生成報(bào)告的宏，可以看出，大致就是把測試截圖全自動(dòng)插入到報(bào)告文件中。

image.png

1.1.1. 已知問題

生成的報(bào)告文件有一個(gè)最大的問題就是當(dāng)目錄下的測試截圖被刪除時(shí)，測試報(bào)告當(dāng)中的圖片就會(huì)顯示為空, 這顯然不是我們想要的效果。

image.png

查看宏代碼得知Pictures.Insert只是引用了路徑下的圖片，圖片不能隨文件一起保存，所以要解決這個(gè)問題。

        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方法，因?yàn)樵谖臋n中只存儲(chǔ)圖片的鏈接信息，圖片不能隨文件一起保存
        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 )

image.png

示例

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.新建一個(gè)子過程：

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文件中了。