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

如何将图像从word doc导出到本地驱动器

1 个答案: