如何将word文档中的图片导出到本地

debugcn 发表于 Dev

罗汉

我想将 word 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

李戴

代码将是这样的。

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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。