使用VBA仅将Word文档中的某些页面复制到excel中

问题描述:

1)我使用Microsoft Word通过excel VBA打开pdf.

1) I open a pdf using Microsoft word, through excel VBA.

2)从doc一词,我只希望将第3页和第4页(这两个是不带标题的表)复制到excel

2) From the word doc, I wish to copy only page 3 and page 4 (these two are tables without captions) into excel

3)目前,我只能将整个word文档复制到excel中,这可能很麻烦.

3) at the moment, I could only copy the entire word doc into the excel, which can be troublesome.

下面是我的代码:

Sub convertpdftowordthenexcel()

Dim wordapp As Word.Application
Dim input1 As String
input1 = "C:\Users\Me\Desktop\Fruitjuice.pdf"

'open pdf in word
Set wordapp = New Word.Application

wordapp.documents.Open Filename:=input1, Format:="PDF Files", ConfirmConversions:=False
wordapp.Visible = True
'copy the content of the word file
wordapp.ActiveDocument.Content.Copy     '<------this is where I want to change

'go to excel and paste it there
Workbooks("openpdfusingdoc.xlsm").Worksheets("Sheet1").Activate
Worksheets("Sheet1").Activate
Cells(1, 1).Select
ActiveSheet.PasteSpecial Format:="Text"

wordapp.Quit savechanges:=wdDoNotSaveChanges

End Sub

关于如何执行此操作的任何建议?

Any suggestion on how to do this?

非常感谢你们!

您可以通过表集合访问表-您可能需要确定想要的两个索引号,我假设它们是前两个在文档中

You can access tables through the tables collection - you may need to workout what index number the two you want are, I've assumed they're the first two in the document

 Sub convertpdftowordthenexcel()

 Dim wordapp As Word.Application
 Dim input1 As String
 input1 = "C:\Users\Me\Desktop\Fruitjuice.pdf"

 'open pdf in word
 Set wordapp = New Word.Application

 wordapp.documents.Open Filename:=input1, Format:="PDF Files", ConfirmConversions:=False
 wordapp.Visible = True
'copy the first two tables of the word file
 wordapp.ActiveDocument.tables(1).range.Copy     

 'go to excel and paste it there
 with Workbooks("openpdfusingdoc.xlsm").Worksheets("Sheet1")
     .Cells(1, 1).PasteSpecial Format:="Text"
     wordapp.ActiveDocument.tables(2).range.Copy    
    .cells(.rows.count,1).end(xlup).offset(2,0).pastespecial format:="Text"
  end with
  wordapp.Quit savechanges:=wdDoNotSaveChanges

 End Sub

(PS永不使用Select)

(PS Never use Select)