如何将图像从Word文档导出到本地驱动器

Question

我想将文档doc上的图像导出到本地驱动器如何使用vba从excel中执行此操作。

Sub gen_Files() 

Dim WdApp As Word.Application, Doc As Word.Document, fPath As String 
Dim i As Long 

fPath = ThisWorkbook.Path & Application.PathSeparator & "Test.docx" 
If fPath = "" Or Dir(fPath) = "" Then MsgBox "Invalid file path.": Exit Sub 

Set WdApp = New Word.Application 
WdApp.Visible = True 
Set Doc = WdApp.Documents.Open(fPath) 
Doc.SaveAs2 ThisWorkbook.Path & "\New.docx", FileFormat:=12 

For i = 1 To Doc.InlineShapes.Count 
    'Doc.InlineShapes(i).Range.ExportAsFixedFormat(ThisWorkbook.Path & Application.PathSeparator & i & ".jpg",wdExportFormatXPS,False,,,,,,,,,,) 
Next i 

'Save the file and done 
Doc.Save 
Doc.Close 
WdApp.Quit 

End Sub 

Answer 1

代码会是这样的。

Sub gen_Files() 

Dim WdApp As Word.Application, Doc As Word.Document, fPath As String 
Dim i As Long 
Dim cht As Chart, obj As ChartObject 
Dim Ws As Worksheet 
Dim myFn As String 
Dim shp As InlineShape 

Set Ws = ActiveSheet 

fPath = ThisWorkbook.Path & Application.PathSeparator & "Test.docx" 
If fPath = "" Or Dir(fPath) = "" Then MsgBox "Invalid file path.": Exit Sub 

Set WdApp = New Word.Application 
WdApp.Visible = True 
Set Doc = WdApp.Documents.Open(fPath) 
Doc.SaveAs2 ThisWorkbook.Path & "\New.docx", FileFormat:=12 

For i = 1 To Doc.InlineShapes.Count 
    Set shp = Doc.InlineShapes(i) 
    shp.Range.CopyAsPicture 
    Set obj = Ws.ChartObjects.Add(Range("i1").Left, 0, shp.Width, shp.Height) 
    myFn = ThisWorkbook.Path & Application.PathSeparator & i & ".jpg" 
    With obj.Chart 
     .Paste 
     .Export myFn 
    End With 
    obj.Delete 
Next i 

'Save the file and done 
Doc.Save 
Doc.Close 
WdApp.Quit 

End Sub