Word 2007 VBA Macro to Assemble a Manual from Chapters
The following VBA macro allows you to scan a directory for subdirectories and add INCLUDETEXT fields with additional bookmarks to create a master document which can be used to create several different versions of the same content. It will also create stubs for each chapter, based on the admin types.
This is very helpful for manuals.
This macro was used with a master docm file which was supported by a directory called Chapters. The Chapters directory had a numerically named subdirectory for each chapter, and within each chapter there were documents for all the admin types, as well as a Common.docm file which included text for all admin types. The content control is in the admin type file, which can be empty to omit the chapter from the manual, a single INCLUDETEXT of Common.docm to just display the common text, or any other appropriate content.
MasterDocument.docm
Chapters
1
- Common.docm
- System.docx
- Application.docx
- Editor.docx
- Guest.docx
2
- Common.docm
- System.docx
- Application.docx
- Editor.docx
- Guest.docx
The document needs two fields, AdminType and BaseDir. AdminType must be one of those listed in the AdminTypes array, BaseDir must be set to the base directory for the document. I used ASK fields, but a SET should be fine as well.
The document also needs two bookmarks, “ChapterBlockStart” and “ChapterBlockEnd", which indicate where the chapter includes are to be placed.
Chapter numbering is managed with a SEQ field in the master document. Each chapter’s common.docm has a SEQ reference which increments the chapter number. This ensures the chapter numbers are contiguous even if some chapters are omitted for a specific admin type.
Option Base 1
Option Explicit
Global AdminTypes
Sub Init()
' Initialize AdminTypes array
AdminTypes = Array("System", "Application", "Editor", "Guest")
End Sub
Sub FindChapters()
Init
Dim CleanStart, CleanEnd, CleanRange
Dim I, L, T, D, Done
Dim Range
Dim BaseDir, ChapterDir, RootDir
Dim AdminTypeRange, BaseDirRange
' This code removes the old chapters, so you can run the macro on a document to update it if you have
' added more chapters.
CleanStart = ActiveDocument.Bookmarks("ChapterBlockStart").Range.Start
CleanEnd = ActiveDocument.Bookmarks("ChapterBlockEnd").Range.End
Set CleanRange = ActiveDocument.Range(Start:=CleanStart, End:=CleanEnd)
CleanRange.MoveStart wdCharacter, 1
CleanRange.MoveEnd wdCharacter, -1
If CleanRange.Characters.Count > 1 Then CleanRange.Cut
' Position the range at the start of the ChapterBlock
Set Range = ActiveDocument.Bookmarks("ChapterBlockStart").Range
' Get the value of BaseDir. This is probably terribly inefficient.
I = 1
L = ActiveDocument.Fields.Count()
For I = 1 To L
T = ActiveDocument.Fields.Item(I).Code.Text
If (InStr(1, T, "BaseDir", vbTextCompare) <> 0) Then
BaseDir = ActiveDocument.Fields.Item(I).Result()
End If
Next
' Loop through all the chapters. The directory is named 'Chapters'
D = FileSystem.CurDir()
RootDir = BaseDir + "\Chapters\"
I = 1
' This is actually an infinite loop. It uses On Error to terminate when it runs out of chapters
Done = False
While Not Done
' Name the chapter directory
ChapterDir = RootDir + Trim(Str$(I))
' If you can't change into the chapter directory, you're done
On Error GoTo AllDone
' Change into the chapter directory
FileSystem.ChDir (ChapterDir)
' This ensures there is a file for all the admin types for that chapter
CreateChapter (Trim(Str$(I)))
' Each chapter is in a section, on a new page
Range.Sections.Add Range, wdSectionNewPage
' Create the INCLUDETEXT tag
Range.Fields.Add Range, wdFieldIncludeText, Chr(34) + "BaseDir\\Chapters\\" + Trim(Str$(I)) + "\\AdminType.docx" + Chr(34)
' Add in the BaseDir and AdminType fields, so the document is portable and adapts to the admin type
Set BaseDirRange = Range.Duplicate
BaseDirRange.Find.MatchCase = True
BaseDirRange.Find.Text = "BaseDir"
BaseDirRange.Find.Execute
BaseDirRange.Fields.Add BaseDirRange, wdFieldEmpty, , False
Set AdminTypeRange = Range.Duplicate
AdminTypeRange.Find.Text = "AdminType"
AdminTypeRange.Find.Execute
AdminTypeRange.Fields.Add AdminTypeRange, wdFieldEmpty, , False
AdminTypeRange.Collapse wdCollapseEnd
' Advance the range pointer
Range.MoveEnd wdSection, 1
Range.Collapse wdCollapseEnd
' Increment the chapter counter
I = I + 1
Wend
AllDone: MsgBox "Found " + Str$(I - 1) + " Chapters"
' Update the fields
ActiveDocument.Fields.Update
End Sub
Sub CreateChapter(C As String)
Dim I, L
Dim NewDoc, NewRange, BaseDirRange
Dim FileName
I = LBound(AdminTypes)
L = UBound(AdminTypes)
' Loop through all the admin types
For I = 1 To L
FileName = AdminTypes(I) + ".docx"
' If the document doesn't exist
If (Dir(FileName) = "") Then
' Create the document
Set NewDoc = Documents.Add
Set NewRange = NewDoc.Range
' Add an INCLUDETEXT field to include Common.docm which would be the chapter content common
' to all admin types.
NewRange.Fields.Add NewRange, wdFieldIncludeText, Chr(34) + "BaseDir\\Chapters\\" + Trim(Str$(C)) + "\\Common.docm" + Chr(34)
Set BaseDirRange = NewRange.Duplicate
BaseDirRange.Find.MatchCase = True
BaseDirRange.Find.Text = "BaseDir"
BaseDirRange.Find.Execute
BaseDirRange.Fields.Add BaseDirRange, wdFieldEmpty, , False
NewRange.MoveEnd wdSection, 1
NewRange.Collapse wdCollapseEnd
' Save the new file, named by the role and close the window
NewDoc.SaveAs FileName
NewDoc.Close
End If
Next
End Sub
Sincere thanks to the referenced link. If you have questions about the field insertion, you will find the answers there.
For the table of contents, I extended the ChapterBlockStart and used it to indicate the content to include. The footer included the page number with a chapter prefix.
Print article | This entry was posted by elvis on 12/04/10 at 04:07:14 pm . Follow any responses to this post through RSS 2.0. |