Word Hacks [Electronic resources]

Hack 45 Create an Outline-Only Copy of a Document

This hack shows you how to quickly extract just the outline from a document.

While working on a long document, you may want to pass along a copy to someone else to review. But what if you just want a copy of the document's outline? With the macro in this hack, you'll be able to create a copy of a document that includes only the text at or above the specified outline level.

There are nine outline levels, corresponding to each of Word's nine built-in heading styles. The lower the number, the higher the outline level: Level 1 is the highest, Level 9 the lowest. The rest of the text in a document has no outline level; Word calls it "body text."

5.2.1 The Code

Place this macro in the template of your choice [Hack #50] and either run it from the ToolsMacroMacros dialog or put a button for it on a menu or toolbar [Hack #1].

Running this macro brings up the dialog shown in Figure 5-1. The macro first asks the user what the lowest outline level to include should be (1 being the highest). Once the user has chosen a valid outline level, the macro creates a new, blank document. It then copies every paragraph in your document at or above the specified outline level into the new document.

The default outline level is the initial value assigned to lngMaxLevel, which in this case is 4.

Sub MakeOutlineOnlyCopyOfCurrentDoc( )
Dim docFull As Document
Dim docOutline As Document
Dim lngMaxLevel As Integer
Dim strUserInput As String
Dim para As Paragraph
lngMaxLevel = 4
Set docFull = ActiveDocument
Application.ScreenUpdating = False
Do
strUserInput = _
InputBox("Create an outline-only copy of this document " & _
"to what level (1-9)?", _
"Outline Maker", _
lngMaxLevel)
If Len(strUserInput) = 0 Then Exit Sub
If Not strUserInput Like "[1-9]" Then
MsgBox Chr(34) & strUserInput & Chr(34) & _
" is not a valid Outline Level.", _
vbInformation
End If
Loop Until strUserInput Like "[1-9]"
lngMaxLevel = CLng(strUserInput)
Set docOutline = Documents.Add
StatusBar = "Collecting outline information. Please wait ..."
For Each para In docFull.Paragraphs
If para.OutlineLevel <= lngMaxLevel Then
para.Range.Copy
docOutline.Range(docOutline.Range.End - 1).Paste
End If
Next para
StatusBar = "
docOutline.Activate
Application.ScreenUpdating = True
End Sub

Most of the code here deals with the user interface. The actual copying is done by a simple For Each loop [Hack #66], which checks each paragraph in the document and decides whether or not to copy it into the new document.