1) I open a pdf using Microsoft word, through excel VBA.
2) From the word doc, I wish to copy only page 3 and page 4 (these two are tables without captions) into excel
3) at the moment, I could only copy the entire word doc into the excel, which can be troublesome.
below is my code:
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?
Thanks so much guys!
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 Never use Select)
Related
I already have a Macro in Excel that pulls through data from specific tables, rows and columns in a specified Word doc and returns it to cells in my Excel s/sheet. I need to make 2 alterations to the code but my knowledge is not advanced enough.
I need to run this code on multiple Word docs in a specified folder, whether it is .doc or a .docx
I need to establish why on some Word docs, the code fails to pull through the data from the Word doc and I get RUN TIME ERROR CODE '4605' 'The method or property is not available because no text is selected'. I tried putting, 'on error resume next', at the start of the module so it keeps on running to the end, in the hope that some text would get pulled through, but still none of the cells in my Excel s/sheet get populated.
Sub ImportFromWord()
On Error Resume Next
'Activate Word Object Library
Dim WordDoc As Word.Document
Set WordApp = CreateObject("word.application") ' Open Word session
WordApp.Visible = False 'keep word invisible
Set WordDoc = WordApp.Documents.Open("C:\Users\brendan.ramsey\OneDrive - Ofcom\Objectives\Brendan's Objectives 2022-23\Licence calls\test 2.docx") ' open Word file
'copy third row of first Word table
WordDoc.Tables(1).Cell(Row:=1, Column:=3).Range.Copy
'paste in Excel
Range("A3").PasteSpecial xlPasteValues
WordDoc.Tables(4).Cell(Row:=3, Column:=6).Range.Copy
Range("B3").PasteSpecial xlPasteValues
WordDoc.Tables(4).Cell(Row:=3, Column:=3).Range.Copy
Range("C3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=5).Range.Copy
Range("D3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=7).Range.Copy
Range("E3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=2).Range.Copy
Range("F3").PasteSpecial xlPasteValues
WordDoc.Close 'close Word doc
WordApp.Quit ' close Word
End Sub
Your code may behave better if you avoid all that copy/paste and transfer the cell contents directly:
Sub ImportFromWord()
Const FLDR_PATH As String = "C:\Temp\Docs\"
Dim WordDoc As Word.Document, WordApp As Word.Application
Dim rw As Range, f
Set rw = ActiveSheet.Rows(3) 'or some other sheet
f = Dir(FLDR_PATH & "*.doc*") 'check for document
Do While Len(f) > 0
If WordApp Is Nothing Then 'open word if not already open
Set WordApp = CreateObject("word.application")
WordApp.Visible = False
End If
With WordApp.Documents.Open(FLDR_PATH & f, ReadOnly:=True) ' open Word file
WordCellToExcel .Tables(1).Cell(Row:=1, Column:=3), rw.Cells(1)
WordCellToExcel .Tables(4).Cell(Row:=3, Column:=6), rw.Cells(2)
WordCellToExcel .Tables(4).Cell(Row:=3, Column:=3), rw.Cells(3)
'etc etc
.Close savechanges:=False
End With
Set rw = rw.Offset(1) 'next row down
f = Dir() 'next file, if any
Loop
If Not WordApp Is Nothing Then WordApp.Quit ' close Word if it was opened
End Sub
'transfer content from a cell in a Word Table to an Excel range
Sub WordCellToExcel(wdCell As Word.Cell, destCell As Range)
Dim v
v = wdCell.Range.Text
destCell.Value = Left(v, Len(v) - 2) 'remove "end of cell" marker
End Sub
RUN TIME ERROR CODE '4605' 'The method or property is not available because no text is selected'.
Runtime Code 4605 happens when Microsoft Word fails or crashes whilst it's running. It doesn't necessarily mean that the code was corrupt in some way, but just that it did not work during its run-time. This kind of error will appear as an annoying notification on your screen unless handled and corrected. Here are symptoms, causes and ways to troubleshoot the problem.
As the error message says there is no text selected. To find out what property or method gives the error message I'd recommend breaking the chain of calls in the single line of code by declaring each property or method call on a separate line, so you will know which call fails exactly.
I am trying to export each worksheet content (textboxes and shapes, no cellcontent) into a word document. The result is not what I expected. If there are 2 worksheets each one with a text box, 1 text box will be copied twice and the other one won't be copied at all!
Private Sub Export()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
For Each ws In ActiveWorkbook.Worksheets
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
Next ws
End Sub
What I am missing:
Insert a page break after each ws is exported
Understanding why a textbox from a worksheet is copied twice and another textbox from a different worksheet is not copied at all
1. Adding page breaks
If you want to insert a page break at the end of your Word file, you can (1) select the end of the Word content section and (2) insert the page break like this:
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Your code would then look like this:
Private Sub Export_v1()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Next ws
End Sub
2. Avoiding the same text box to be pasted
If you run the above macro, you'll still get the textbox(s) from the first sheet twice. Why? Because you are using Selection.Copy which is dependent on which sheet is active.
To make sure that the correct sheet is active, simply add ws.Activate before selecting the shapes like this:
Private Sub Export_v2()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Next ws
End Sub
3. Potential improvements
3.1 Avoid using Select inside Excel
Avoiding using Select in Excel VBA can lead to major speed improvements. However, in this case you can't just replace
ws.Shapes.SelectAll
Selection.Copy
with
ws.Shapes.Copy
as it won't copy the shapes. Instead, you would need to loop through each shape in the worksheet to paste them one by one. This might introduce more complications to your code, so if speed is not an issue, you could keep it as this.
3.2 Reset objects to nothing
To avoid Excel running out of memory, it is a good practice to always reset objects to nothing after you are done using them (at the end of your procedure in this case):
Set WordApp = Nothing
So we have this table we are using at the office. I changed the Column Name and Content for confidentiality purposes.
We're trying create a Word Document for each ID consisting of all the Name's and Surnames for that ID only from our Excel file.
i.e. A new Word Document is created for ID1. The contents are all the Names and Surnames only for that ID1 excluding the Column Name. Another Word Document will be created for the next ID available until all IDs have their own document,
So far this is what I got:
Sub test()
Dim copyRng As Range
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set copyRng = Range("B2:C" & lastrow)
Range("B2:C" & copyRng.Rows.Count).Select
Selection.Copy
'Declare Word Variables
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
'Create a new instance of Word
Set WrdApp = New Word.Application
WrdApp.Visible = True
WrdApp.Activate
'Create a new Document in the Word Application
Set WrdDoc = WrdApp.Documents.Add
WrdDoc.Activate
WrdDoc.Range(WrdDoc.Characters.Count - 1).Paste
End Sub
I can't seem to copy only the rows for a specific ID.
Can anyone suggest a better solution copy only the cells based on the IDs?
I simplified my problem in the meantime.
First I select the cells I want to be copied over to a Word Document.
Then I run this code:
Selection.Copy
'Declare Word Variables
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
'Create a new instance of Word
Set WrdApp = New Word.Application
WrdApp.Visible = True
WrdApp.Activate
'Create a new Document in the Word Application
Set WrdDoc = WrdApp.Documents.Add
WrdDoc.Activate
With WrdDoc.Range(WrdDoc.Characters.Count - 1).Characters.Last
.PasteExcelTable False, True False
With .Tables(1)
.AutoFitBehavior wdAutoFitWindow
End With
.InsertAfter Chr(1)
End With
This way, I just have to highlight the cells I want to be copied over to Word and Run the Macro. The Macro will create a new Word Document for me.
I'm fairly new to VBA and trying to populate a preexisting excel document based on Word Documents.
The Word Documents will have three tables, and certain cells will become the Excel columns. The idea is, every day new product information sheets come in and the Excel sheet will need to be appended. I've started by looking over this previously asked question. Do I create a macro-enabled excel sheet and run it from within Excel? Could I get the macro to look inside a directory for the word documents, and perform an iterative macro?
How about this?
Sub ImportFromWord()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(ThisWorkbook.Path & "\My document.doc")
'Use below line if document is already open.
'Set wrdDoc = Documents("My document.doc")
With wrdDoc
N_Of_tbles = .Tables.Count
If N_Of_tbles = 0 Then
MsgBox "There are no tables in word document"
End If
Set wrdTbl = .Tables(1)
ColCount = wrdTbl.Columns.Count
RowCount = wrdTbl.Rows.Count
' Loop through each row of the table
For i = 1 To RowCount
'Loop through each column of that row
For j = 1 To ColCount
'This gives you the cell contents
Worksheets("sheet1").Cells(i, j) = wrdTbl.Cell(i, j).Range.Text
Next j
Next i
End With
Set wrdDoc = Nothing
Set wrdApp = Nothing
MsgBox "completed"
End Sub
That's the simplest solution. In Excel set a reference to Word in the VB Editor using Tools, References - you can then write code to manipulate Word from within Excel. You can use the keyword DIR to look for files in a folder, then declare a Word object, open the word document, iterate over the tables in the document and copy the values across to the right cells in Excel. Just watch for the ^p character that Word sticks in the cells - I tend to out the word cell's contents into a string variable and then take Left(s,len(s)-1) into excel to drop the last char.
I'm trying to copy a series of charts in one sheet to one document in word, but for some reason I only get the latest paste (meaning the last chart on the sheet). I know that the iteration goes through all charts, becausewhen I modofiy the code to print a single word doc for each chart it does so, but I want the charts together, so please help me out
The code:
Sub ChartsToWord()
Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Dim iCht As Integer
Dim Msg As String
Set WDApp = CreateObject("Word.Application")
Set WDDoc = WDApp.Documents.Add
For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
WDDoc.Content.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
WDDoc.Content.InsertParagraphAfter
Next
WDDoc.SaveAs ("C:\Users\confidential\Documents\charts.doc")
WDDoc.Close ' close the document
' Clean up
Set WDDoc = Nothing
Set WDApp = Nothing
End Sub
Please replace beginning of PasteSpecial line into:
WDApp.Selection.Range.PasteSpecial ... 'and so on
In your situation you paste chart into whole document instead of current paragraph.
One more suggestion. You could use the following to insert new paragraph:
WDApp.Selection.MoveEnd wdStory
WDApp.Selection.Move