简体   繁体   中英

How to copy word pages and paste into excel?

I am trying to capture pages in word as image and paste in Excel via VBA.

Function openFile() As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Word Files", "*.doc*", 1
        .Show
        openFile = .SelectedItems.Item(1)
    End With
End Function

Function readWord(ByVal path As String)
    Debug.Print "Read word", path
    
    Set objWordApp = CreateObject("Word.Application")
    Set objWordDoc = objWordApp.Documents.Open(path)
    
    Set objSheet = ThisWorkbook.Sheets.Add(After:= _
                   ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    Set objRange = objSheet.Range("A1")
    objSheet.Activate
    
    objWordApp.Visible = False

    Dim objPage As Object 'Page
    Dim objPane As Object 'Pane
    Dim objWindow As Object 'Window
     
    For Each objWindow In objWordDoc.Windows
        For Each objPane In objWindow.Panes
            For Each objPage In objPane.Pages
                Debug.Print "Page"
                objPage.Range.Copy // Stop here because Page doesn't have the Range property
                
                objRange.Select
                objRange.Parent.PasteSpecial DataType:=wdPasteMetafilePicture
                
            Next objPage
        Next objPane
    Next objWindow
    
    objWordDoc.Close
    objWordApp.Quit
End Function

Sub processWord()
    Dim p As String
    p = openFile()
    readWord (p)
End Sub

Because Page doesn't have the Range property, How to select Range for each page?

Basically:

Dim i As Long, wdRng As Object
With objWordDoc
  Set wdRng = .Range(0, 0)
  For i = 1 To .ComputeStatistics(2)
    ' Point to the page we want to process
    Set wdRng = wdRng.GoTo(1, , i)
    Set wdRng = wdRng.GoTo(-1, , , "\Page")
    wdRng.Copy
    ' Output the page.
    objRange.Parent.PasteSpecial DataType:=wdPasteMetafilePicture
  Next i
End With

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM