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."

While in Outline view, you can select FilePrint to print just the outline of a document. The Print Preview feature, however, will not correctly display the document.

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.

Figure 5-1. Select which outline levels to include from your 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.