Const MON_IMAGE As String = "C:\monImage.jpg"
Sub ExportSaveImage()
Dim ILS As InlineShape
Dim WB As Object 'Excel.Workbook
Dim SH As Shape
For Each ILS In ActiveDocument.InlineShapes
If ILS.Type = wdInlineShapePicture Then ILS.ConvertToShape
Next ILS
For Each SH In ActiveDocument.Shapes
If SH.Type = msoPicture Then
SH.Select
Selection.Copy
Selection.Collapse
Set WB = CreateObject("Excel.Sheet")
With WB.Sheets(1).ChartObjects.Add(0, 0, SH.Width, SH.Height).Chart
.Paste
.Export MON_IMAGE, "jpg"
End With
WB.Sheets(1).[a1].Copy
WB.Application.Quit
Set WB = Nothing
Exit For
End If
Next SH
End Sub