MinLevel = CInt(InputBox("This macro will generate a new document that contains only the headers from the existing document. MinLevel = 1 'levels above this value won't be copied.
I've extended the functionality slightly: now it prompts the user to enter a minimum level, and supresses subheadings below that level.
This macro worked beautifully for me (Word 2010). I ended up iterating the lines of the TOC, because it works even from VBScript: For Each Paragraph In Doc.TablesOfContents(1).Range.Paragraphs
WORD DOCUMENT HEADINGS CODE
This must be a VBScript-specific problem, because I can access the elements if I run the same code in Word's VBA editor. IntDiff = Len(strOriginal) - Len(strTemp)Īlthough astrHeadings is an array ( IsArray returns True, and TypeName returns String()) I get a type mismatch error when I try to access its elements in VBScript (v4 on Windows 16299.248). ' Trim leading spaces, and then compare with ' 0 spaces, H2 has 2 spaces, H3 has 4 spaces. ' outline level (2 spaces per level: H1 has ' The number of leading spaces indicates the ' Return the heading level of a header from the Private Function GetLevel(strItem As String) As Integer ' then collapse the range for the next entry. ' Set the style of the selected range and IntLevel = GetLevel(CStr(astrHeadings(intItem))) ' GetCrossReferenceItems(wdRefTypeHeading) returns an array with references to all headings in the documentĪstrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)įor intItem = LBound(astrHeadings) To UBound(astrHeadings) ' Content returns only the main body of the document, not the headers/footer.
GetCrossReferenceItems(wdRefTypeHeading) function is the key in this program, and should allow you to retrieve what you are asking for) Public Sub CreateOutline() You mean like this createOutline function (which actually copy all headings from a source word document into a new word document):
0 kommentar(er)
