提供网上示例代码供参考(此代码的思路是遍历 word 文档中的 Shapes ,缩放到原始图片尺寸,再转粘贴到 Excel 中,借用 Excel 的 ChartObjects 提供的导出功能实现图片原样导出):
Sub test()
Rem 工具--引用--勾选 Microsoft Excel x.x Object Library..
Dim myshape As Object, ExcelApp As New Excel.Application
Dim Excel As Workbook, i%, z%
Set Excel = ExcelApp.Workbooks.Add
For Each myshape In ActiveDocument.InlineShapes
If myshape.Type = 3 Then
i = i + 1
myshape.Select
Set myshape = myshape.ConvertToShape
Rem 以下代码将图片以原始比例展示
With myshape
.ScaleHeight 1, True, msoScaleFromMiddle
.ScaleWidth 1, True, msoScaleFromMiddle
End With
Selection.Copy
With Excel.ActiveSheet.ChartObjects.Add(0, 0, myshape.Width, myshape.Height).Chart
.Paste
.Export ActiveDocument.Path & "" & i & ".png"
.Parent.Delete
End With
End If
Next
Excel.Close False
ExcelApp.Quit
End Sub