Check if Word document closed from Excel VBA - vba

I'm performing several prints of embedded Word document witch has some fields linked to some cells, by my PrintOut macro, in a For..Next loop, as below.
I need after each print task, that the program wait for document to close and then doing the next print.
In this situation I receive error. Can anyone help ?
Sub contract()
Dim i As Integer
For i = 1 To 100
Cells(Sheets("SheetName").ListObjects("StaffInfo").ListRows.Count + 9, 8).Value = i
General.PrintIt ("EmbeddedDoc") 'Doc has many linked fields
Next i
End Sub
Print method
Sub PrintIt(P As String)
Dim objWord As Object
Dim ObjDoc As Object
Dim Oshp As Object
Application.ScreenUpdating = False
ActiveSheet.OLEObjects(P).Activate
Set objWord = GetObject(, "Word.Application")
objWord.Visible = False
Set ObjDoc = objWord.ActiveDocument
ObjDoc.Fields.Update
For Each Oshp In ObjDoc.Content.ShapeRange
Oshp.TextFrame.TextRange.Fields.Update
Next
ObjDoc.PrintOut Background:=False
ObjDoc.PrintOut
objWord.Quit SaveChanges:=False
Application.ScreenUpdating = True
End Sub 'Print it

Introduced problem was solved by this code.
Above code do open and close embedded word document, 100 times, and that problem was happening in close document.
Exactly, I cant understand why closing document immediately after printout command that where after open and update fields, generating that error.
Thus I cleaned the problem ask!
By integrating "PrintIt" method in "Contract" method that is parent of that, without calling "PrintIt" for each document printout, embedded document opens each one, perform doc links updating and printing 100 times in for next loop and close word app and document, at last, each one too.
In short, I cant find reason of problem in several Open-Print-Close document in order immediately; But i change the algorithm to Open-Several print-Close and problem been cleaned!
Sub contract()
Application.ScreenUpdating = False
Sheets("SheetName").Unprotect
'Declare variables
Dim i As Integer
Dim objWord, ObjDoc As Object
'Core
ActiveSheet.OLEObjects("Contract").Activate
Set objWord = GetObject(, "Word.Application")
objWord.Visible = False
Set ObjDoc = objWord.ActiveDocument
For i = 1 To 100
Cells(x, y).Value = i 'A specific cell that
' word embedded document fields are linked to
'corresponding fields they values change
'by changing this cell.
ObjDoc.Fields.Update
ObjDoc.PrintOut Background:=False
ObjDoc.PrintOut
Next i
objWord.Quit SaveChanges:=False
Sheets("SheetName").Protect AllowFiltering:=True
End Sub

Related

Opening and then breaking links to a Word document from Excel

I have an excel spreadsheet that is linked to multiple Word documents (.docx), which act as templates.
I have written a macro that opens the required word template from excel (the template chosen is dependent on the value of cell M17). The links in the word template update automatically as word opens. I am then trying to break the links of the document that I opened. This is what I have so far:
Function FnOpeneWordDoc()
Dim objWord
Dim objDoc
Dim path As String
path = Range("M17")
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("*file_path*" & path & ".docx")
objWord.Visible = True
Application.Wait (Now + TimeValue("0:00:30"))
objDoc.Fields.Unlink
End Function
I suspect that it isn't working because the macro is trying to break the links before the document has fully loaded (and therefore the existing links haven't had a chance to update?), which is why I added the wait. Unfortunately this doesn't seem to be the solution.
The above code would have been fine, but I didn't realise that the code had to be different if the text was in textboxes.
I struggled to break the links within textboxes, and kept getting run-time error 438. However, I found a workaround:
I wrote a sub in the word documents:
Sub Unlink
Selection.Fields.Unlink
End Sub
I then called this macro from my excel document:
Sub FnOpeneWordDoc()
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("filename")
objWord.Visible = True
For i = 1 To objDoc.Shapes.Count
objDoc.Shapes(i).Select
objDoc.Application.Run ("unlink")
Next
End Sub

Only copy cells with data from Excel to Word

I need some further help developing my code. I have the basics down now with some earlier help but I am not sure on this next part.
The code I am designing will run in a spreadsheet whereby the amount of rows used in a sheet will vary depending on the amount of data being used. (Due to nature of business and Norwegian Laws, I can't go into more details.)
I'd like to have a Range of B5:B1000 as a standard range and only have cells containing data be auto filled into the template but I am unsure how to write said code. Could someone please advise how I am able to go about this?
All questions related to this have been based on copying from one sheet to another.
This is my code so far which I am using in excel:
Sub CopyRangeToWord()
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("C:\Users\CoffeeFuelsMeNow\Documents\Custom Office Templates\EVERYTHING IS AWESOME.dotx")
Range("B5:B92").Copy
With objDoc.Paragraphs(objDoc.Paragraphs.Count).Range
'All formatting goes here
.PasteAndFormat (wdFormatPlainText)
End With
objWord.Visible = True
End Sub
This assumes that column B is compact (no holes in the data):
Sub CopyRangeToWord()
Dim objWord, N As Long
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.documents.Add
N = Cells(Rows.Count, "B").End(xlUp).Row
Range("B5:B" & N).Copy
With objDoc.Paragraphs(objDoc.Paragraphs.Count).Range
'All formatting goes here
.PasteAndFormat (wdFormatPlainText)
End With
objWord.Visible = True
End Sub

Pasting a table into open Word document at a bookmark

I have searched a fair bit on this and other forums but I can't get code to work. I know this is user error - I am learning/self-taught at this.
What I want is to copy a (admittedly large) table in a specific Excel worksheet into an already-open Word document, at a specific point. I have seen this done using a keyword search but I would prefer to use a bookmark (and I've made the bookmark thing work!) purely because it's not visible to the end user. I'm trying to automate the creation of a document as much as possible.
The below code works, but I can only get it to work when the Word document in question is closed. If I try to run this sub when the word doc is open, it just tries to re-open it and of course can't. I can't find a neat bit of code that allows me to paste data into an already-open document.
Also, I can make this work for one value, but not for a range (i.e. the table I want to paste).
Sub ExcelRangeToWord()
Dim objWord As Object
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Summary")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'open the word doc
objWord.Documents.Open "K:\Exeter Office\Quotebuilder project\testbed\test.docx" 'change as required
'pastes the value of cell I19 at the "heatlosses" bookmark
With objWord.ActiveDocument
.Bookmarks("heatlosses").Range.Text = ws.Range("I19").Value
End With
'Optimize Code
Set objWord = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
I'm trying to tackle this one step at a time, cos then I have half a chance of understanding things a bit better...
If I try and copy/paste a range, instead of just one value, I was using Currentregion to select all used cells surrounding B19:
With objWord.ActiveDocument
.Bookmarks("heatlosses").Range.Text = Range("B19").CurrentRegion
End With
All this does is paste the word "True" into Word.
I am baffled. Please, can anyone offer assistance?
Use the code below to achieve what you require:
Sub CopyToWord()
Dim wApp, wDoc
'Get the running word application
Set wApp = GetObject(, "Word.Application")
'select the open document you want to paste into
Set wDoc = wApp.documents("test.docx")
'copy what you want to paste from excel
Sheet1.Range("A1").copy
'select the word range you want to paste into
wDoc.bookmarks("heatlosses").Select
'and paste the clipboard contents
wApp.Selection.Paste
End Sub

Copy and paste on new page

I am trying to write a code that copies the contents of multiple worksheets in a single workbook into a single word document. I want the content of each worksheet to be on its own page, but right now, my code is just copying and pasting over each other instead of going onto a new page and pasting. I've tried going to the end of the document but it isn't working... Any advice would be helpful.
Sub ToWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Set Wkbk1 = ActiveWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
Dim wdapp As Object
Dim wddoc As Object
Dim Header As Range
Dim strdocname As String
'file name & folder path
On Error Resume Next
'error number 429
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'create new instance of word application
Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
'define paths to file
strdocname = "C:\Doc.doc"
If Dir(strdocname) = "" Then
MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Doc.doc", vbExclamation, "The document does not exist "
Exit Sub
End If
wdapp.Activate
Set wddoc = wdapp.Documents(strdocname)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strdocname)
'must activate to be able to paste
wddoc.Activate
wddoc.Range.Paste
Next ws
'Clean up
Set wddoc = Nothing
Set wdapp = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
you can just use:
wddoc.Range(i).Paste
incrementing i by 1 after each image. that pastes them one after another.
or more simply:
wddoc.Range(wddoc.Characters.Count-1).Paste
then could get more complicated and add a page break manually in between each if images are small to ensure a new page for each:
wddoc.Range(wddoc.Characters.Count-1).InsertBreak Type:=7
https://msdn.microsoft.com/en-us/library/office/ff821608.aspx
EDIT
First, I incorrectly assumed the "wddoc.range" property would get wherever the cursor is. This is not true. You need to use the code provided by Miss Palmer (and replicated below).
However, there is an additional issue I didn't notice at first. Your loop is set incorrectly. You are looping through and continually reopening the word doc. You need to move these lines:
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
so that they are immediately above the
wddoc.Range(wddoc.Characters.Count - 1).Paste
line. This will cause the loop to be executed properly and only open the word doc once.
Also (again, per Miss Palmer), you want to put this:
wddoc.Range(wddoc.Characters.Count - 1).Paste
wddoc.Range(wddoc.Characters.Count - 1).InsertBreak (wdPageBreak)after the line:
instead of the ".range.paste" that you originially had.
The other issue with your "Selection" line is that you did not specify the application you wanted to use. This was using Excel's selection by default as it was being run from Excel.
This code assumes that you have a word document that doesn't have enough pages. Otherwise you could likely use the code you want, but it's unclear why you would have a blank word document with many pages. You'd still need to specify the app you want to move to the next page in, so put "wdapp." before the selection line.
http://word.tips.net/T000120_Jumping_to_the_Start_or_End_of_a_Document.html

Excel VBA: Copy XL named range values to DOC bookmarks, then export to PDF

I'm trying to copy the values from a named range in Excel to a bookmark in Word. I found this code on the web that does it in Excel VBA, but I'm getting an Error 13.
Set pappWord = CreateObject("Word.Application")
Set docWord = pappWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
I know that the line that is causing the error is:
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
What am i doing wrong? Also, how & where would I code so that I can export the doc to PDF?
Thanks in advance.
Note: I've already selected the reference to the Microsoft Word (version number 14) Object model in Excel
so I use it to accomplish this task but taking an image from formatted Excel table.
Sub FromExcelToWord()
Dim rg As Range
For Each xlName In wb.Names
If docWord.Bookmarks.Exists(xlName.Name) Then
Set rg = Range(xlName.Value)
rg.Copy
docWord.ActiveWindow.Selection.Goto what:=-1, Name:=xlName.Name
docWord.ActiveWindow.Selection.PasteSpecial link:=False, DataType:=wdPasteEnhancedMetafile, Placement:= _
0, DisplayAsIcon:=False
End If
Next xlName
End Sub
Just curious... Why are you adding a document rather than opening the relevant doc which has the bookmarks? Try this code (I usually test the code before posting but I haven't tested this particular code. Just quickly wrote it)
Also I am using Late Binding so no reference to the Word Object Library is required.
Sub Sample()
Dim wb As Workbook
Dim pappWord As Object, docWord As Object
Dim FlName As String
Dim xlName As Name
FlName = "C:\MyDoc.Doc" '<~~ Name of the file which has bookmarks
'~~> Establish an Word application object
On Error Resume Next
Set pappWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set pappWord = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
Set docWord = pappWord.Documents.Open(FlName)
Set wb = ActiveWorkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName).Value
End If
Next xlName
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
End Sub
EDIT
Changed
Range(xlName.Value)
to
Range(xlName).Value
Now the above code is TRIED AND TESTED :)