ID Employee Date
1234 me 11/03/2015
9999 U 11/03/2015
1111 Us 11/03/2015
Hi,
I have the above table in excel that is populated when a user completes a userform and clicks a 'Save' Button. Once they have saved an 'Export' button is enabled and the user can export the last record (row) submitted by the user form to a word template in the relevant locations on the template. I have created bookmarks in the attached word template for ID,Employee and Date and would like the data to be exported to these locations.
I've written the following code on the 'Export' button but I can't seem to get the export to work. the code runs up until the template is opened but the posting of the data to the bookmarks causes an error.
Sub PDFExportRow()
Dim WRD As Object, DOC As Object, ac As Long
On Error Resume Next
Set WRD = CreateObject("Word.Application")
If Err.Number <> 0 Then
Set WRD = CreateObject("Word.Application")
End If
On Error GoTo 0
Set DOC = WRD.Documents.Open("C:\RC_QA_TEST\Template\QA_REPORT.dotm")
WRD.Visible = True
ac = ActiveCell.Row
With DOC
.FormFields("ID").Result = Cells(ac, "A")
.FormFields("Employee").Result = Cells(ac, "B")
.FormFields("Date").Result = Cells(ac, "C")
End With
'set active printer to one you use here
WRD.ActivePrinter = "CutePDF Writer"
'print document
DOC.PrintOut
'close document without saving
DOC.Close False
'close application
WRD.Quit
Set WRD = Nothing
Set DOC = Nothing
End Sub
Any help on this is greatly appreciated.
If the code is having errors starting with the DOC.FormFields part, then I think the problem is that you haven't actually used Form Fields, you have used bookmarks, so you need to use the appropriate methods.
Try this:
With DOC
.Bookmarks("ID").Range.Text = Cells(ac, "A")
.Bookmarks("Employee").Range.Text = Cells(ac, "B")
.Bookmarks("Date").Range.Text = Cells(ac, "C")
End With
Note that once you update the text in a bookmark, the bookmark is removed from the document. Since you are closing the document without saving it, when you reopen, the bookmark will be there again, but you would need to reset the bookmark if you were to save the word doc, or keep it open and try to replace the text again.
Related
I want to set up a VBA so that for any document based on a template hidden bookmarks are deleted prior to the document closing. We publish documents on our website. They are written as Word and an API converts them to html. If there are hidden bookmarks they appear as links on the website (the hidden bookmarks convert to html anchors). Currently we remove the bookmarks manual prior to the API, but this is time consuming (we publish 1000s of documents a year) and ineffective (people forget).
I found VBA to remove hidden bookmarks which works and tried to add DocumentBeforeClose as the trigger. But it doesn't work:
Private Sub DocumentBeforeClose(cancel As Boolean)
Dim nBK As Long
With ActiveDocument
For nBK = .Bookmarks.Count To 1 Step -1
If LCase(Left(.Bookmarks(nBK).Name, 3)) = "_hl" Then
.Bookmarks(nBK).Delete
End If
Next nBK
End With
ActiveDocument.Save
End Sub
I went through Visual Basic Window, Normal, Microsoft Word Objects, ThisDocument.
Nothing happens, the hidden bookmarks remain if I close and re-open the document.
I think you need to add this line :
.Bookmarks.ShowHidden = True
Like this it should work :
Private Sub DocumentBeforeClose(cancel As Boolean)
Dim nBK As Long
With ActiveDocument
.Bookmarks.ShowHidden = True
For nBK = .Bookmarks.Count To 1 Step -1
If LCase(Left(.Bookmarks(nBK).Name, 3)) = "_hl" Then
.Bookmarks(nBK).Delete
End If
Next nBK
End With
ActiveDocument.Save
End Sub
This has solved it:
Sub AutoClose()
On Error Resume Next
Dim nBK As Long
With ActiveDocument
.bookmarks.ShowHidden = True
For nBK = .bookmarks.Count To 1 Step -1
If LCase(Left(.bookmarks(nBK).Name, 3)) = "_hl" Then
.bookmarks(nBK).Delete
End If
Next nBK
End With
ActiveDocument.Save
End Sub
Only issue is that it tries to run when you open a document and puts up an error message that there is no active document. 'On error resume next' is to stop that error message
For our incident management side of our database I am trying to have data from fields in my table(s) generate within the 149 Investigative Report, a Word document template provided by the state (see link here).
I made a read-only version of the document to preserve its integrity by forcing a save as by the user and loaded it with text form fields with bookmarks to reference (example: txtcaseintroduction).
I modified code I found in the internet for working with form fields and assigned it to a button on one of my forms to assist in generating the report (the Open reference is modified for security reasons):
Private Sub cmdPrint_Click()
'Export 149 Report.
Dim appWord As Word.Application
Dim doc As Word.Document
'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set appWord = New Word.Application
End If
Set doc = appWord.Documents.Add("Y:\ABC\2018\Case Files\2018 - Incident Forms\OPWDD 149 - Access Database Reference.docx", , True)
With doc
.FormFields("txtNIMRS").Result = Me.NIMRSID
.FormFields("txtInternalID").Result = Me.InternalIncidentID
.FormFields("txtIncidentDate").Result = Me.[IncidentOccurrenceDate]
.FormFields("txtDiscoverydate").Result = Me.[IncidentReportDate]
.FormFields("txtCaseIntroduction").Result = Me.CaseIntroduction
.FormFields("txtIncidentLocation").Result = Me.Location
.FormFields("txtBackground").Result = Me.BackgroundInfo
.FormFields("txtProtections").Result = Me.ImmedProtec
.FormFields("txtQuestion").Result = Me.InvestQuestion
.FormFields("txtTestName").Result = Me.[TestimonialEvidence]
.FormFields("txtDocumentaryE").Result = Me.[DocumentaryEvidence]
.FormFields("txtDemonstrativeE").Result = Me.[DemonstrativeEvidence]
.FormFields("txtPhysicalE").Result = Me.[PhysicalEvidence]
.FormFields("txtWSName").Result = Me.[WrittenStatements]
.FormFields("txtSummary").Result = Me.SummaryEvidence
.FormFields("txtConclusions").Result = Me.Text409
.FormFields("txtRecommendations").Result = Me.Text411
.FormFields("txtInvestigator").Result = Me.Investigator_s__Assigned
.FormFields("txtdatereport").Result = Me.Investigative_Report_Completion_Date
.Visible = True
.Activate
End With
Set doc = Nothing
Set appWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
The following fields work:
.FormFields("txtNIMRS").Result = Me.NIMRSID
.FormFields("txtInternalID").Result = Me.InternalIncidentID
.FormFields("txtIncidentDate").Result = Me.[IncidentOccurrenceDate]
.FormFields("txtDiscoverydate").Result = Me.[IncidentReportDate]
.FormFields("txtIncidentLocation").Result = Me.Location
.FormFields("txtBackground").Result = Me.BackgroundInfo
.FormFields("txtProtections").Result = Me.ImmedProtec
.FormFields("txtQuestion").Result = Me.InvestQuestion
.FormFields("txtConclusions").Result = Me.Text409
.FormFields("txtRecommendations").Result = Me.Text411
.FormFields("txtdatereport").Result = Me.Investigative_Report_Completion_Date
The remaining fields (case introduction, investigator, and the attachment fields) do not. All of these fields exist on the same table. It is also noted that case introduction used to work, but stopped working as I tried to figure out more form fields to apply to the document and reference. The goal was to have the investigator essentially do all of their work in the database and then export it to the required format for submission to the state.
My question: what do I need to do to the above code to get the non-working fields functional in populating the Word document?
Responding to questions in comments
No error that occurs; the text-boxes are simply not populating when I engage the button.
The form fields do not need to be present in the result document. They are simply "targets" for the data.
Since the form fields do not need to be retained in the result document the simplest approach would be to simply insert the data to the FormField.Range, which will replace (remove) the form field. The entire code can be written in this manner if consistency is important (how the end result looks to the user), but from a programming stand-point need not be.
Note: If Forms protection is activated, it needs to be turned off for this approach to work
If doc.ProtectionType <> -1 Then doc.Unprotect '-1 = wdNoProtection
Sample code line for a string longer than 255 characters
.FormFields("txtCaseIntroduction").Range = Me.CaseIntroduction
I've come here for plenty of advice on how to develop VBScript and VBA applications using Excel, but now I've been faced with a new challenge: develop a VBScript/VBA application for Word.
I know, in Excel, if I wanted to type "my name" in cell B3, I would type this:
Range("B3").Value = "my name"
I need to be able to locate where a name and address for a formal letter would be entered, as well as today's date, and my initials as a signature.
I thought I might be able to find VBScript/VBA programming for Word on the internet like I did for Excel, but it seems like working with Word is not as popular. If anyone has any snippets to get me started, or a really good link to a site on the internet where I can do the coding myself, it would be greatly appreciated.
UPDATE
Here is the code I'm working with at the moment:
Public Sub WordVbaDemo()
Dim doc As Document: Set doc = ActiveDocument ' Or any other document
DateText = doc.Range(doc.Paragraphs(1).Range.End - 20, doc.Paragraphs(1).Range.End - 18).Text
End Sub`
I need the code to work for a formal letter where the date is right-justified:
Date: November 7th, 2016
The code I have above will copy the date text after "Date: ". The original template doesn't have a prefilled date. If I enter one, the "Member: " field looks offset like this:
Date: November 7th, 2016
Member:
I'm looking for a way to enter text without upsetting the alignment.
UPDATE 2
I forgot to mention this has to work as an external script. This means, if I were to open NotePad and create a script that would fill out a letter in a Word document, that is how it should work. I do apologize for this...got ahead of myself and forgot that detail.
UPDATE 3
I'm using the following code derived from code I use to find any open Internet Explorer windows. I know IE and Word are two different things, but I was hoping I could use Shell to find the Word doc and be able to manipulate the content.
Dim WinDoc, Window, TitleFound
Dim WShell, objShell
Function Check_Document()
On Error Resume Next
Set WShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
On Error GoTo 0
Window = "non-member template.docx" 'Tried this without the .docx and failed
TitleFound = False
For Each WinDoc In objShell.Windows()
If Err.Number = 0 Then
If InStr(WinDoc.Document.Title, (Window)) Then
Set objWord = WinDoc
TitleFound = True
Exit For
End If
End If
Next
If TitleFound = False Then
MsgBox "Word doc not found"
Else
MsgBox "Found Word doc!!"
End If
End Function
I was in a similar boat about 6 months ago. I had done VBA in Excel, but was asked to do some more in Word. The thing about Word VBA is that there are far fewer reasons to need to automate a Word document than an Excel document. From what I've gathered, most situations involve creating legal documents.
I've come a long way and I do have a number of sites bookmarked that I'll dig further into for you.. but this one is a quickstart to using VBA in Word.
http://word.mvps.org/faqs/MacrosVBA/VBABasicsIn15Mins.htm
But one pointer: consider if the document layout is going to be structured or not.(It wasn't clear to me in your question). If the layout is going to be structured, where you know exactly where everything is going, you might want to use bookmarks. Otherwise, you may consider the paragraphs method as indicated by z32a7ul.
My project uses UserForms as input. It's been a real challenge at times, but by using Userforms with Bookmarks, I'm able to allow the user to navigate back and forth in the userForms as well as re-run the macro (assuming they have not deleted required bookmarks).
Of course, take this with a grain of salt since I'm still learning as well. For what it's worth, I've also had the added challenge of making this all work on the Mac platform.
As a starting point:
Public Sub WordVbaDemo()
Dim doc As Document: Set doc = ActiveDocument ' Or any other document
' doc.Paragraphs(2).Range.Text = "Error if the document is empty (there is no second paragraph)."
doc.Paragraphs(1).Range.Text = "First paragraph overwritten." & vbCrLf
doc.Paragraphs(2).Range.Text = "Now I can write to Paragraph 2." & vbCrLf
doc.Paragraphs.Add(doc.Paragraphs(2).Range).Range.Text = "Inserted between Paragraph 1 and 2." & vbCrLf
doc.Range(doc.Paragraphs(3).Range.End - 3, doc.Paragraphs(3).Range.End - 2).Font.StrikeThrough = True
doc.Range(doc.Paragraphs(3).Range.End - 2, doc.Paragraphs(3).Range.End - 2).Text = 3
doc.Range(doc.Paragraphs(3).Range.End - 3, doc.Paragraphs(3).Range.End - 2).Font.StrikeThrough = False
With doc.Tables.Add(doc.Range(doc.Range.End - 1), 2, 2)
.Cell(1, 1).Range.Text = "Header1"
.Cell(1, 2).Range.Text = "Header2"
.Cell(2, 1).Range.Text = "Value1"
.Cell(2, 2).Range.Text = "Value2"
Dim varBorder As Variant: For Each varBorder In Array(wdBorderTop, wdBorderBottom, wdBorderLeft, wdBorderRight, wdBorderVertical, wdBorderHorizontal)
.Borders(varBorder).LineStyle = wdLineStyleSingle
Next varBorder
.Rows(1).Shading.BackgroundPatternColor = RGB(123, 45, 67)
.Rows(1).Range.Font.Color = wdColorLime
End With
End Sub
First of all, I want to thank everyone who replied. You helped guide me to my solution. Below is the code I came up with to locate where a name and address for a formal letter would be entered, as well as today's date, and my initials as a signature.
Function Check_Document()
On Error Resume Next
Set objWord = CreateObject("Word.Application")
On Error GoTo 0
objWord.Visible = True
Set objDoc = objWord.Documents.Open("C:\Users\lpeder6\Desktop\myDoc.docx")
Set objRange = objDoc.Bookmarks("TodaysDate").Range
objRange.Text = "November 11th, 2016"
Set objRange = objDoc.Bookmarks("Name").Range
objRange.Text = "John Smith"
Set objRange = objDoc.Bookmarks("Address").Range
objRange.Text = "123 N. Anywhere Ave."
Set objRange = objDoc.Bookmarks("City").Range
objRange.Text = "Northwoods" & ", "
Set objRange = objDoc.Bookmarks("State").Range
objRange.Text = "MN"
Set objRange = objDoc.Bookmarks("Zip").Range
objRange.Text = "55555"
Set objRange = objDoc.Bookmarks("Init").Range
objRange.Text = "JS"
End Function
The bookmarks are preset within the document so the code has something to look for. Anything within these fields gets replace with the objRange.Text. Variables could be used to store information if this was external coding and the variables would contain data from arguments sending the data.
I hope this code helps others as much as it helped me. Thanks again to everyone who offered me ideas that got me here.
I have built - over the years - a vba macro that is supposed to update all fields in a word document.
I invoke this macro before releasing the document for review to ensure all headers and footers etc are correct.
Currently - it look like this:
Sub UpdateAllFields()
'
' UpdateAllFields Macro
'
'
Dim doc As Document ' Pointer to Active Document
Dim wnd As Window ' Pointer to Document's Window
Dim lngMain As Long ' Main Pane Type Holder
Dim lngSplit As Long ' Split Type Holder
Dim lngActPane As Long ' ActivePane Number
Dim rngStory As Range ' Range Objwct for Looping through Stories
Dim TOC As TableOfContents ' Table of Contents Object
Dim TOA As TableOfAuthorities 'Table of Authorities Object
Dim TOF As TableOfFigures 'Table of Figures Object
Dim shp As Shape
' Set Objects
Set doc = ActiveDocument
Set wnd = doc.ActiveWindow
' get Active Pane Number
lngActPane = wnd.ActivePane.Index
' Hold View Type of Main pane
lngMain = wnd.Panes(1).View.Type
' Hold SplitSpecial
lngSplit = wnd.View.SplitSpecial
' Get Rid of any split
wnd.View.SplitSpecial = wdPaneNone
' Set View to Normal
wnd.View.Type = wdNormalView
' Loop through each story in doc to update
For Each rngStory In doc.StoryRanges
If rngStory.StoryType = wdCommentsStory Then
Application.DisplayAlerts = wdAlertsNone
' Update fields
rngStory.Fields.Update
Application.DisplayAlerts = wdAlertsAll
Else
' Update fields
rngStory.Fields.Update
If rngStory.StoryType <> wdMainTextStory Then
While Not (rngStory.NextStoryRange Is Nothing)
Set rngStory = rngStory.NextStoryRange
rngStory.Fields.Update
Wend
End If
End If
Next
For Each shp In doc.Shapes
If shp.Type <> msoPicture Then
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
End If
Next
' Loop through TOC and update
For Each TOC In doc.TablesOfContents
TOC.Update
Next
' Loop through TOA and update
For Each TOA In doc.TablesOfAuthorities
TOA.Update
Next
' Loop through TOF and update
For Each TOF In doc.TablesOfFigures
TOF.Update
Next
' Header and footer too.
UpdateHeader
UpdateFooter
' Return Split to original state
wnd.View.SplitSpecial = lngSplit
' Return main pane to original state
wnd.Panes(1).View.Type = lngMain
' Active proper pane
wnd.Panes(lngActPane).Activate
' Close and release all pointers
Set wnd = Nothing
Set doc = Nothing
End Sub
Sub UpdateFooter()
Dim i As Integer
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
'Get page count
i = ActiveDocument.BuiltInDocumentProperties(14)
If i >= 1 Then 'Update fields in Footer
For Each footer In ActiveDocument.Sections(ActiveDocument.Sections.Count).Footers()
footer.Range.Fields.Update
Next
End If
Application.ScreenUpdating = True
End Sub
'Update only the fields in your footer like:
Sub UpdateHeader()
Dim i As Integer
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
'Get page count
i = ActiveDocument.BuiltInDocumentProperties(14)
If i >= 1 Then 'Update fields in Header
For Each header In ActiveDocument.Sections(ActiveDocument.Sections.Count).Headers()
header.Range.Fields.Update
Next
End If
Application.ScreenUpdating = True
End Sub
I have noticed recently that it sometimes misses some sections of the document. Today it missed First page footer -section 2- (the document version was not updated).
I have built this macro over a number of years and several bouts of research but I am not proud of it so please suggest a complete replacement if there is now a clean way of doing it. I am using Word 2007.
To test, create a word document and add a custom field named Version and give it a value. Then use that field {DOCPROPERTY Version \* MERGEFORMAT } in as many places as you can. Headers, Footers, first-page, subsequent page etc. etc. Remember to make a multi-section document with different header/footers. Then change the property and invoke the macro. It currently does quite a good job, handling TOCs and TOAs an TOFs etc, it just seems to skip footers (sometimes) in a multi-section document for example.
Edit
The challenging document that seems to cause the most problems is structured like this:
It has 3 sections.
Section 1 is for the title page and TOC so the first page of that section has no header/footer but does use the Version property on it. Subsequent pages have page numbering in roman numerals for the TOC.
Section 2 is for the body of the document and has headers and footers.
Section 3 is for the copyright blurb and this has a very strange header and a cut-down footer.
All footers contain the Version custom document property.
My code above seems to work in all cases except sometimes it misses first page footer of sections 2 and 3.
For years, the standard I've used for updating all fields (with the exception of TOC, etc. which are handled separately) in a document is the one the Word MVPs use and recommend, which I'll copy here. It comes from Greg Maxey's site: http://gregmaxey.mvps.org/word_tip_pages/word_fields.html. One thing it does that I don't see in your version is update any fields in Shapes (text boxes) in the header/footer.
Public Sub UpdateAllFields()
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
On Error Resume Next
rngStory.Fields.Update
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
oShp.TextFrame.TextRange.Fields.Update
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
Some research and experimentation produced the following addition which seems to solve the additional problem of updating the headers/footers in a multi-section document.
Add the following dimensions to the earlier answer:
dim sctn as Word.Section
dim hdft as Word.HeaderFooter
And then, add to the earlier code
for each sctn in doc.Sections
for each hdft in sctn.Headers
hdft.Range.Fields.Update
next
for each hdft in sctn.Footers
hdft.Range.Fields.Update
next
next
However - I am still not happy with this code and would very much like to replace it with something less hacky.
Thanks for these answers! I found the answers very good and learned some stuff about ms-word macros. I thought I'd make my own answer for consideration (and adding some more search engine keywords - my searches didn't bring me here immediately).
I took inspiration from the citations in the footnotes.
I had an issue where MS Word fields were not updating in Textbox (Shapes).
I was working on a 70 page word document (Word 2013) that contained a lot of figures/images/captions and cross-references. A common practice is for an image to be captioned e.g. Figure 7, so it can be easily cross-referenced. Often the caption is inside a textbox (shape) and grouped with/to the object its captioning.
So after some document editing and content reorganisation, the fields and cross-references can easily get out of logical sequence.
OK - no problem... pressing CTRL+A then F9 to update the document fields should solve this?
Unfortunately that didn't work as expected to update fields in textboxes (shapes).
In this scenario where fields exist inside textboxes (shapes) CTRL+A then F9 only updated the fields not inside a textbox (shape).
One can assume this behaviour is because field updating (F9) works on selected text, and with the CTRL+A then F9 approach only text outside of the textboxes (shapes) is selected, so the field update only applies outside of textboxes (shapes).
I'm surprised there is not a button on the ribbon to perform an "update all fields". There could even be a toggle option to prompt the user to update all fields when closing a document?
I checked Word's (2013) ribbon command list, and didn't find an Update All command.
Solution UpdateAllFields()
Like the code shared by #Cindy here, the following code should update fields wherever they are in the doc, header, footer, main doc, textbox, grouped and nested grouped textbox.
Create a macro with the following code, and then add to the Quick Access Toolbar (QAT)
Press ALT+F8 to open the Macros dialogue.
Enter a name for the Macro: UpdateAllFields
Press Create button
Paste the code:
Sub UpdateAllFields()
Application.ScreenUpdating = False
With ActiveDocument
.Fields.Update
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
End Sub
Finally add the Macro to the Quick Access Toolbar.
Citations and inspirations:
The Q&A's in this post!
There is a related post on the Microsoft Community here: Word 365 Fields not updating in Textbox [serious reproducible error]. This suggests the issue is present in at least Word 2013 and Word 365.
There is a related post on Stack Overflow here: Macro to update fields in shapes (textboxes) in footer in Microsoft Word.
Another example UpdateTextboxFields()
This was the first version of code I wrote as I was in research and solution mode. Its a recursive approach to update fields inside textboxes, even if they are inside a group, or nested group. This doesn't update fields outside shapes.
Public Sub UpdateTextboxFields()
Application.ScreenUpdating = False
With ActiveDocument
Call IterateShapesCollection(.Shapes)
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
End Sub
Private Sub IterateShapesCollection(col)
Dim shp As Shape
For Each shp In col
' https://learn.microsoft.com/en-gb/office/vba/api/office.msoshapetype
' Ignore images and
If 1 = shp.Type Or 13 = shp.Type Then
GoTo NextIteration
End If
'Debug.Print ("Name: " & shp.Name & ", Type: " & shp.Type)
' if the type is a group, recurse
If 6 = shp.Type Then
Call IterateShapesCollection(shp.GroupItems)
Else
Call UpdateShapeFields(shp)
End If
NextIteration:
Next
End Sub
Private Sub UpdateShapeFields(shp)
With shp.TextFrame
If .HasText Then
.TextRange.Fields.Update
End If
End With
End Sub
Word display option: Update fields before printing
cite: Microsoft article Some fields are updated while other fields are not
The concept behind this option/approach is: all document fields are updated when you open print preview.
It looks like this option in Word (tested in 2013) updates all fields with a caveat - see below - you may need to open and close print preview twice.
File → Options → Display → Print options section → Update fields before printing
Caveat if the doc has cross-references to figures/captions
This caveat applies to the word "Update fields before printing" display option and the UpdateAllFields() macro.
IF the document contains cross-references to figures/captions (with numbers), and those figures/captions have changed sequence/place in the document...
You must update the fields twice, 1) to reflect the figures/captions update, and then 2) to update the cross-references.
The problem I have got is that my corporate template set uses a SaveDate field in the footer of every word document - which is used to detail when the document was saved, which ties in with our custom document management system.
Subsequently, when users want to make a PDF of an old document, using the Save As PDF function of Office 2010, the Save Date is updated - creating a PDF of the old document, but with today's date. This is wrong. We are just trying to create a true PDF version of whatever the original document has in it.
To get around this, I am writing a macro solution which locks the fields, exports the document as a PDF and then unlocks the fields again.
I have come up against an issue where I can identify and lock all fields in the headers/footers (which is actually what I'm trying to do) but to make it more robust, need to find out a way to lock ALL FIELDS in ALL SECTIONS.
Showing you my code below, how can I identify all fields in all sections? Will this have to be done using the Index facility?
Sub CPE_CustomPDFExport()
'20-02-2013
'The function of this script is to export a PDF of the active document WITHOUT updating the fields.
'This is to create a PDF of the document as it appears - to get around Microsoft Word 2010's native behaviour.
'Route errors to the correct label
'On Error GoTo errHandler
'This sub does the following:
' -1- Locks all fields in the specified ranges of the document.
' -2- Exports the document as a PDF with various arguments.
' -3- Unlocks all fields in the specified ranges again.
' -4- Opens up the PDF file to show the user that the PDF has been generated.
'Lock document fields
Call CPE_LockFields
'Export as PDF and open afterwards
Call CPE_ExportAsPDF
'Unlock document fields
Call CPE_UnlockFields
'errHandler:
' MsgBox "Error" & Str(Err) & ": " &
End Sub
Sub CPE_LockFields()
'Update MS Word status bar
Application.StatusBar = "Saving document as PDF. Please wait..."
'Update MS Word status bar
Application.StatusBar = "Locking fields in all section of the active document..."
'Declare a variable we can use to iterate through sections of the active document
Dim docSec As section
'Loop through all document sections and lock fields in the specified ranges
For Each docSec In ActiveDocument.Sections
docSec.Footers(wdHeaderFooterFirstPage).Range.fields.Locked = True
docSec.Footers(wdHeaderFooterPrimary).Range.fields.Locked = True
docSec.Footers(wdHeaderFooterEvenPages).Range.fields.Locked = True
Next
End Sub
Sub CPE_UnlockFields()
'Update MS Word status bar
Application.StatusBar = "PDF saved to DocMan Temp. Now unlocking fields in active document. Please wait..."
'Declare a variable we can use to iterate through sections of the active document
Dim docSec As section
'Loop through all document sections and unlock fields in the specified ranges
For Each docSec In ActiveDocument.Sections
docSec.Footers(wdHeaderFooterFirstPage).Range.fields.Locked = False
docSec.Footers(wdHeaderFooterPrimary).Range.fields.Locked = False
docSec.Footers(wdHeaderFooterEvenPages).Range.fields.Locked = False
Next
End Sub
Sub CPE_ExportAsPDF()
'Update MS Word status bar
Application.StatusBar = "Saving document as PDF. Please wait..."
'Chop up the filename so that we can remove the file extension (identified by everything right of the first dot)
Dim adFilename As String
adFilename = Left(ActiveDocument.FullName, (InStrRev(ActiveDocument.FullName, ".", -1, vbTextCompare) - 1)) & ".pdf"
'Export to PDF with various arguments (here we specify file name, opening after export and exporting with bookmarks)
With ActiveDocument
.ExportAsFixedFormat outPutFileName:=adFilename, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateWordBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End With
'Update MS Word status bar
Application.StatusBar = "PDF saved to DocMan Temp."
End Sub
Try something like the following to get to all fields in the document, header, footer, background and main text:
Sub LockAllFieldsInDocument(poDoc As Document, Optional pbLock As Boolean = True)
Dim oRange As Range
If Not poDoc Is Nothing Then
For Each oRange In poDoc.StoryRanges
oRange.Fields.Locked = pbLock
Next
End If
Set oRange = Nothing
End Sub
Here is another way to do it. It'll select the entire document and then lock all fields, before deselecting everything.
Sub SelectUnlink()
ActiveDocument.Range(0, 0).Select
Selection.WholeStory
Selection.Range.Fields.Unlink
Selection.End = Selection.Start
End Sub