XML Feeds
This is a macro that reads a (Microsoft) Word 2007 document which uses INCLUDETEXT fields to draw in content from other documents and exports the content as a PDF, including a table of contents and index.
There are three administrator types or roles - System, Partner, and Limited. For each chapter, an INCLUDETEXT field includes the content for that role, for example:
{INCLUDETEXT "{BaseDir}//Overview//{AdminRole}.docx"}
The document for each role has the appropriate content. In most cases, the directory has a Common.docx file that has the text for all roles, and those authorized to view it include the file like so:
{INCLUDETEXT "{BaseDir}//Overview//Common.docx"}
Unauthorized users would have an empty .docx file, or one with a limited version of content.
The way the macro works is to first extract the value of BaseDir, which allows an absolute path to be used, but modified without updating all the files. Relative paths just didn’t work well.
The document also uses some bookmarks, which the macro uses to reference different sections. One bookmark includes all the content from both the chapters and appendices. The chapters are enclosed in a bookmark called ‘Chapter’, and the appendices are enclosed in a bookmark called ‘Appendix’. These bookmarks are used to create the footers, since the chapters are numeric and the appendices are alphabetic. If content for the chapter is included for the role, a section break is inserted. This ensures that the chapter and page numbers are consequetive, even if chapters are omitted.
Code:
Option Base 1 | |
Option Explicit | |
Global AdminTypes | |
| |
Sub Init() | |
AdminTypes = Array("System", "Partner", "Limited") | |
End Sub | |
| |
Sub CreatePDFs() | |
| |
Dim C, D, I, L, N, T, F, BaseDir, FieldCount | |
Dim BaseDirFieldItemIndex, AdminTypeFieldItemIndex, CurrentYearFieldItemIndex | |
Dim rngTemp As Range, rngField As Range | |
Dim fldPtr As Field | |
Dim J, JL, JU, arrBookmarks(2) As String | |
Dim Selection As Range | |
Dim Footer As Range | |
Dim S As String, LastFooterType As String | |
| |
Init | |
I = 1 | |
AdminTypeFieldItemIndex = 0 | |
BaseDirFieldItemIndex = 0 | |
| |
FieldCount = ActiveDocument.Fields.Count() | |
| |
For I = 1 To FieldCount | |
T = ActiveDocument.Fields.Item(I).Code.Text | |
If (InStr(1, T, "BaseDir", vbTextCompare) <> 0) Then | |
BaseDirFieldItemIndex = I | |
End If | |
If (InStr(1, T, "AdminType", vbTextCompare) <> 0) Then | |
AdminTypeFieldItemIndex = I | |
End If | |
If (InStr(1, T, "CurrentYear", vbTextCompare) <> 0) Then | |
CurrentYearFieldItemIndex = I | |
End If | |
If AdminTypeFieldItemIndex <> 0 And BaseDirFieldItemIndex <> 0 And CurrentYearFieldItemIndex <> 0 Then Exit For | |
Next | |
| |
' Set the current year for the copyright date | |
Set rngTemp = ActiveDocument.Fields.Item(CurrentYearFieldItemIndex).Code | |
rngTemp.Text = " SET CurrentYear " + Chr(34) + Str$(DatePart("yyyy", Date)) + Chr(34) + " " | |
| |
' Set the base directory for INCLUDETEXT tags | |
ActiveDocument.Fields.Item(BaseDirFieldItemIndex).Update | |
D = ActiveDocument.Fields.Item(BaseDirFieldItemIndex).Result() | |
Set rngTemp = ActiveDocument.Fields.Item(BaseDirFieldItemIndex).Code | |
rngTemp.Text = " SET BaseDir " + Chr(34) + D + Chr(34) + " " | |
D = D + Chr(92) | |
| |
' Setup the loop boundaries for the roles | |
I = LBound(AdminTypes) | |
L = UBound(AdminTypes) | |
| |
' Set up the sections that will be processed | |
arrBookmarks(1) = "Chapter" | |
arrBookmarks(2) = "Appendix" | |
JL = LBound(arrBookmarks) | |
JU = UBound(arrBookmarks) | |
LastFooterType = "" | |
| |
' Loop through all the admin types or roles | |
For N = I To L | |
| |
' Set the role for this document | |
Set rngTemp = ActiveDocument.Fields.Item(AdminTypeFieldItemIndex).Code | |
rngTemp.Text = " SET AdminType """ + AdminTypes(N) + """ " | |
ActiveDocument.Fields.Item(AdminTypeFieldItemIndex).Update | |
| |
' Update all the fields for this role | |
Set rngTemp = ActiveDocument.Bookmarks("ChapterBlockStart").Range | |
rngTemp.Select | |
rngTemp.Fields.Update | |
| |
' Loop through the sections that will be processed. | |
' Each included file is checked to see if content was included | |
' Files that have content are followed by a section break, empty files are not | |
For J = JL To JU | |
| |
Set rngTemp = ActiveDocument.Bookmarks(arrBookmarks(J)).Range | |
rngTemp.Select | |
| |
For Each fldPtr In rngTemp.Fields | |
' Loop through all the field in this section or group of included files | |
T = fldPtr.Type | |
' If this field is an INCLUDETEXT | |
If (T = wdFieldIncludeText) Then | |
T = Trim(fldPtr.Result()) | |
' If the included text is not empty | |
If (T <> "") And (Asc(T) <> 13) Then | |
Set rngField = ActiveDocument.Range | |
rngField.Find.Text = fldPtr.Code | |
' Search the document for the tag. This ensures included tags do not add section breaks | |
rngField.Find.Execute | |
If rngField.Find.Found Then | |
' Select the tag | |
rngField.Select | |
' Advance the range to the end of the field | |
rngField.MoveEnd wdCharacter, 2 | |
rngField.Collapse wdCollapseEnd | |
' Page numbering starts at 1 for all sections | |
rngField.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.StartingNumber = 1 | |
rngField.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = True | |
If LastFooterType = arrBookmarks(J) Then | |
rngField.Sections(1).Footers(wdHeaderFooterPrimary).LinkToPrevious = True | |
Else | |
rngField.Sections(1).Footers(wdHeaderFooterPrimary).LinkToPrevious = False | |
' Create new footer | |
Set Footer = rngField.Sections(1).Footers(wdHeaderFooterPrimary).Range | |
Footer.Select | |
' Clear any existing text | |
Footer.Delete | |
' Set up the table | |
Footer.Tables.Add Range:=Footer, NumRows:=1, _ | |
NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed | |
With Footer.Tables(1) | |
.Borders.Enable = False | |
If .Style <> "Table Grid" Then | |
.Style = "Table Grid" | |
End If | |
.ApplyStyleHeadingRows = False | |
.ApplyStyleLastRow = False | |
.ApplyStyleFirstColumn = False | |
.ApplyStyleLastColumn = False | |
.ApplyStyleRowBands = False | |
.ApplyStyleColumnBands = False | |
End With | |
' Left column | |
Set Selection = Footer.Tables(1).Cell(1, 1).Range | |
Selection.Select | |
Selection.Collapse wdCollapseStart | |
Selection.Text = "Mobiso " + AdminTypes(N) + " Administrator's Guide" | |
' Right column | |
Selection.Start = Footer.Tables(1).Cell(1, 2).Range.Start | |
Selection.Select | |
Selection.Collapse wdCollapseStart | |
Selection.Text = arrBookmarks(J) + " <field> - <page>" | |
Selection.Find.Text = "<field>" | |
If Selection.Find.Execute Then | |
Selection.Select | |
S = "SEQ Chapter \c" | |
If arrBookmarks(J) = "Appendix" Then | |
S = S + " \* ALPHABETIC" | |
Else | |
S = S + " \* ARABIC" | |
End If | |
Selection.Fields.Add Range:=Selection, Type:=wdFieldEmpty, Text:=S, PreserveFormatting:=False | |
End If | |
Selection.Find.Text = "<page>" | |
If Selection.Find.Execute Then | |
Selection.Select | |
Selection.Fields.Add Range:=Selection, Type:=wdFieldEmpty, Text:="PAGE", PreserveFormatting:=False | |
End If | |
Footer.Tables(1).Cell(1, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight | |
LastFooterType = arrBookmarks(J) | |
End If | |
' Insert the section break | |
rngField.InsertBreak wdSectionBreakNextPage | |
End If | |
End If | |
End If | |
Next fldPtr | |
Next J | |
| |
Set rngTemp = ActiveDocument.Bookmarks("Appendix").Range | |
rngTemp.Select | |
rngTemp.Find.Execute FindText:="^b", ReplaceWith:="", Replace:=wdReplaceOne, Forward:=False | |
| |
' Update table of contents and index | |
ActiveDocument.TablesOfContents.Item(1).Update | |
ActiveDocument.Indexes.Item(1).Update | |
| |
'MsgBox "Exporting " + AdminTypes(N) + " manual to PDF (" + D + AdminTypes(N) + ".pdf)" | |
ActiveDocument.ExportAsFixedFormat D + AdminTypes(N) + ".pdf", wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportAllDocument | |
| |
' Remove the inserted section breaks | |
For J = JL To JU | |
Set rngTemp = ActiveDocument.Bookmarks(arrBookmarks(J)).Range | |
rngTemp.Find.Execute FindText:="^b", ReplaceWith:="", Replace:=wdReplaceAll | |
Next J | |
| |
' Helpful if you want to build one PDF, then check it | |
'If (MsgBox("Built " + AdminTypes(N) + " PDF", vbOKCancel, "Continue?") = vbCancel) Then Exit For | |
| |
Next | |
| |
MsgBox "Done - Updated PDFs are in " + D | |
| |
End Sub |
This code has good examples of the following with VBA:
- Set a FIELD tag
- Delete a section break
- Export a Word document
- Create a footer
- Create a table
- Insert a section break
This post courtesy of http://mobiso.com
Permalink