View Full Version : Table of Contents for documenter?


geoB
04-07-2010, 01:04 PM
In Access 2007:

I'm hoping someone already has a technique for generating a table of contents for database documenter output.

So far I've gotten the documenter output in Word and can format a portion of the page heading to be marked for a table of contents. [Replace all <tab> Page: # with nothing, replace "Query:" with formatted "Query:", etc.] When the TOC is generated there are duplicates for those objects occupying more than one page. It would be nice to only generate the TOC with unique headings.

Or is this an opportunity to teach myself some VBA for Word?

Thanks.

George

geoB
04-10-2010, 01:44 PM
Okay, I took a run at coding a TOC for a documenter report. Assuming the documenter is saved as a Word document, here's some code that will mark the unique object items in the documenter for generating a table of contents. Other features include removing bold from the entire report and removing the hard-wired page numbers. There may be a more efficient or elegant ways to do this, but the following appears to work. Code goes in Word's NORMAL.DOTM. Once MarkTOC is run you can insert a TOC however you like. I add a page ahead of the documenter, then a section break, and start the documenter section at page 1.

[edit: Tried to add marking for "Sub" and "Function" inside objects, but the text strings are too unpredictable - they can show up in comments, etc.]

George

Sub MarkTOC()
Dim objects(), obj
ReDim TOC(6)
Dim strTOC As String
Dim i As Integer
Dim rng As Range

ActiveDocument.ShowGrammaticalErrors = False
ActiveDocument.ShowSpellingErrors = False
Application.ScreenUpdating = False
Set rng = ActiveDocument.Content
'turn off bold in case it's on
rng.Bold = False

'remove hard-wired page numbers
StripPageNumbers

'define array of possible objects in documentation
objects() = Array("Form", "Query", "Module", "Table", "Report", "Macro")
i = 1

'define array of objects that exist in documentation
For Each obj In objects()
Set rng = ActiveDocument.Content
If rng.Find.Execute(findtext:=obj & ":", Forward:=True) Then
TOC(i) = obj
i = i + 1
End If
Next
i = i - 1
ReDim Preserve TOC(i)

'set a heading style for unique objects in documentation
For Each obj In TOC()
Set rng = ActiveDocument.Content
Do While rng.Find.Execute(findtext:=obj & ": ", Forward:=True)
rng.Expand unit:=wdParagraph
If rng.Text <> strTOC And InStr(rng.Text, obj) = 1 Then
strTOC = rng.Text
rng.Style = wdStyleHeading3
End If
rng.Collapse direction:=wdCollapseEnd
Loop
Next
Application.ScreenUpdating = True
End Sub

Sub StripPageNumbers()
Dim length As Integer, doclen As Integer, i As Integer, j As Integer
Dim strPage As String, strChars As String, strPara As String
Dim strReplace As String
Dim rng As Range

'get number of pages
length = ActiveDocument.ComputeStatistics(wdStatisticPages)
'determine number of iterations to perform
doclen = Len(Trim(Str(length)))
strPage = "^tPage: "
strChars = "^#"
strPara = "^p"

'for each order of magnitude, remove existing hard-wired page number
For i = 1 To doclen
Set rng = ActiveDocument.Content
strReplace = strPage
For j = 1 To i
strReplace = strReplace & strChars
Next j
strReplace = strReplace & strPara
rng.Find.Execute findtext:=strReplace, replacewith:=strPara, Forward:=True, Replace:=wdReplaceAll
Next i
End Sub