壹、 數據模擬
為了更加真實的還原提問者遇到的問題，我們需要準備600個且都包含有2個圖片的Excel文件。壹兩個文件我們可以手動新建就可以了，這可是600個文件吶！
別擔心，既然我們是用VBA來解決問題，解決這種事情重復機械的勞動，當然不是什麽難事。圖片我們用以下兩個代替，放到當前文件目錄下，分別命名為test1.png和test2.png，模擬數據時將test1.png插入到第壹個表,test2.png插入到第二個工作表。
test1.png
test2.png
分步操作過程:
第壹步:新建壹個Excel文件，將它另存為.xlsm格式。
啟用宏工作簿
第二步:打開新建好的.xlsm文件，按快捷鍵ALT+F11進入VBE界面。
進入VBE界面
第三步:在VBE工程種插入壹個模塊。
插入模塊
第四步:在剛剛新建的模塊中粘貼以下代碼。
Sub 生成600個含圖片的Excel文件()
'關閉刷新，防止屏幕抖動
Application.ScreenUpdating = False
'定義變量i
Dim i As Integer
'定義i從1循環到600
For i = 1 To 600
'新增壹個工作簿
Workbooks.Add
'往工作簿的第壹個工作表中插入圖片test1.png
ActiveWorkbook.Sheets(1).Pictures.Insert(ThisWorkbook.Path & "\test1.png").Select
'往工作簿的第二個工作表中插入圖片test2.png
ActiveWorkbook.Sheets(2).Pictures.Insert(ThisWorkbook.Path & "\test2.png").Select
'將工作簿存儲到當前路徑下
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & i & ".xlsx"
'關閉工作簿
ActiveWorkbook.Close
'繼續循環新建其他工作簿
Next
'恢復屏幕刷新
Application.ScreenUpdating = True
'處理完成給出提示
MsgBox "600個含圖片的Excel文件生成完成！", vbInformation, "提示信息"
End Sub
第五步:執行VBA代碼，生成我們需要的600個Excel文件。
執行VBA代碼
連貫操作演示:
操作演示
二、 圖片導出
600個案例文件已經準備好了，接下來就是導出文件中的圖片。
解決思路:
1. 壹個個的找出當前目錄下的所有Excel文件。
2. 打開找到的Excel文件。
3. 壹個個的找出Excel文件中的工作表。
4. 找出工作表中的所有圖片對象。
5. 把找到的每壹個圖片導出到當前目錄下。
如果文件不多的情況下，按上面的思路手動操作導出也是可以的，其實通過VBA來解決問題也是要先把復雜問題進行簡單化，壹步步進行分解問題，最終形成完整解決方案。VBA代碼使用方式在上面數據準備過程中已經有詳細描述了，本次我們直接來運行下代碼，實現導出文件中的圖片。
Sub 導出當前路徑下工作簿中的圖片()
Dim wk$ '定義為工作簿文件
Dim i As Integer '定義工作簿中的工作表數量
Dim ii As Integer '定義為工作表中的對象個數
'關閉刷新，防止抖動
Application.ScreenUpdating = False
'遍歷第壹個工作簿文件
wk = Dir(ThisWorkbook.Path & "\*.xlsx")
'遍歷到的文件名不等於空的情況下
Do While wk <> ""
'如果文件名稱和當前的名稱是不壹樣的。
If wk <> ThisWorkbook.Name Then
'打開遍歷到的工作簿
Workbooks.Open (ThisWorkbook.Path & "\" & wk)
'對打開的工作簿文件進行以下操作
With ActiveWorkbook
'循環出工作簿中的每壹個工作表
For i = 1 To .Sheets.Count
'循環出工作表中的每壹個對象shape
For ii = 1 To .Sheets(i).Shapes.Count
'臨時變量，統計shape的個數
k = k + 1
'復制shape對象
.Sheets(i).Shapes(ii).Copy
'創建壹個圖表對象，寬高與與對象保持壹致
With .Sheets(i).ChartObjects.Add(0, 0, .Sheets(i).Shapes(ii).Width, .Sheets(i).Shapes(ii).Height).Chart
'把圖片插入進去
.Paste
'通過圖表對象的導出方法，把圖片導出到當前目錄下
.Export ThisWorkbook.Path & "\" & wk & "_" & k & ".png"
'刪除圖表
.Parent.Delete
End With
Next
Next
'關閉打開的工作簿
.Close False
End With
End If
'繼續遍歷下壹個工作簿
wk = Dir
Loop
'開啟屏幕刷新
Application.ScreenUpdating = True
End Sub
圖片導出演示