You are here:

Microsoft Word/Adding specifics to Hierarchy Macro

Advertisement


Question
QUESTION: Hello Mr. Heritage,
Below is a macro that I found that I use to help sort and convert the hierarchy I have in my Microsoft Word documents into headings. This helps with TOC and organization of my document. I am having one slight issue though. The macro searches for !##! that is right next to the hierarchy number. The macro finds them, and then counts the amount of "."'s in the ENTIRE LINE. I only want it to count the amount of "." in the hierarchy number.
For Example
A line in the hierarchy will normally (with fake info) look as follows:
1   Book
1.1   Book Name
1.1.1   Book Title
2   Address
2.1   Address.Name.Number

With the macro as it currently runs, "2.1 Address.Name.Number" will be read as having 3 "."'s instead of 1. I need it to run as only 1 "." not 3. It completely changes what heading it receives. The macro has notes in it to explain what it does.

Thank you,
David





Private Sub CreateHeadings()
   ' This Sub was created by Borland. The Sub takes all of the Headings of the
   ' Requirements and changes their styles based on the hiearachy number. This
   ' was only done so that the document looks nicer.
   
   Dim blnBase1 As Boolean
   Dim i, lngPage As Long
   Dim intDotCount, intHeadStyle As Integer
   Dim strKey, strSel, strHierarchy As String
   
   ' CreateHeadings
   ' This routine scans document for strKey, which identifies a Heading style
   ' to be changed. The strKey must be part of the DocFactory Template.
   ' (e.g. !##!<<hierarchy>>   <<name>> (<<tag>><<id_number>>).
   
   ' The strKey is deleted and the ".'s" in the hierarchy are counted.
   
   ' There is an option for base 0 or base 1.
   ' blnBase1 = False has no "." at the end of hierarchy (e.g. 1, 1.1, 1.1.1).
   ' blnBase1 = True has a "." at the end of hierarchy (e.g. 1., 1.1., 1.1.1.).
   
   strKey = "!##!"     ' String to Search for
   blnBase1 = False    ' Is there a "." at the end of Hierarchy? Yes = True, No = Flase.
   
   ' Show Field Codes so the document does not Search through the TOC, etc...
   
   ActiveWindow.View.ShowFieldCodes = True
   
   ' Go to top of document
   Selection.HomeKey Unit:=wdStory
   
   ' Set Search Criteria
   Selection.Find.ClearFormatting
   With Selection.Find
       .Text = strKey          ' Find this string
       .Replacement.Text = ""
       .Forward = True
       .Wrap = wdFindContinue
       .Format = False
       .MatchCase = False
       .MatchWholeWord = False
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   
   ' Loop Through the Search
   Do While Selection.Find.Execute
       Selection.Delete Unit:=wdCharacter, Count:=1    ' Delete strKey
       Selection.EndKey Unit:=wdLine, Extend:=wdExtend
       Selection.Expand Unit:=wdParagraph      ' Select to End of Paragraph (This seems to be the issue. Need to
         ' find a way to select ONLY the hierarchy, calculate the Heading
         ' Style from that, then go back and copy the entire paragraph, then
         ' apply the heading style.)
       strSel = Selection.Text     ' Store selection information
       intHeadStyle = funCalcHeadStyle(strSel)     ' Calculate Head Style
       ' Apply Heading Style
       Selection.Style = ActiveDocument.Styles("Heading " & Trim(Str(intHeadStyle)))
       
       ' Need to set the Selection Criteria, again...
       Selection.Find.ClearFormatting
       With Selection.Find
         .Text = strKey          ' Find this string
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
       End With
   
   Loop
   
   ' Show Fields like TOC
   ActiveWindow.View.ShowFieldCodes = False
End Sub

Private Function funCalcHeadStyle(ByVal strSel) As Integer
   ' This Function calculates the Heading Style for strSel.
   ' It assumes there is AT LEAST one space after Hierarchy.
    
   Dim blnBase1 As Boolean
   Dim i, lngPage As Long
   Dim intDotCount, intHeadStyle As Integer
   Dim strKey, strHierarchy As String
   For i = 1 To Len(strSel)
       If Mid(strSel, i, 1) = " " Then ' The document found the first space after hierarchy.
         strHierarchy = Left(strSel, i - 1)
       End If
   Next i
   
   intDotCount = 0     ' Reset Count
   For i = 1 To Len(strHierarchy)
       If Mid(strHierarchy, i, 1) = "." Then   ' Count the "." (s)
         intDotCount = intDotCount + 1
       End If
   Next i
   
   ' If there is no "." at the end of the Hierarchy then add 1 to the Heading Style.
   ' So zero "." = Heading Style 1 & one "." = Heading Style 2
   
   If blnBase1 = False Then
       intDotCount = intDotCount + 1
   End If
   
   funCalcHeadStyle = intDotCount
   
   If intDotCount = 0 Then
       MsgBox ("Error in" & strHierarchy & vbCrLf & "Check blnBase1 Variable")
       End
   End If

End Function

ANSWER: It's always interesting checking someone else's code BUT if I've read it right this bit

For i = 1 To Len(strSel)
      If Mid(strSel, i, 1) = " " Then ' The document found the first space after hierarchy.
        strHierarchy = Left(strSel, i - 1)
      End If
  Next i
  


is the culprit - it KEEPS setting the variable everytime it finds a space, so it is storing the final space location not the first - by changing it to

For i = 1 To Len(strSel)
      If Mid(strSel, i, 1) = " " Then ' The document found the first space after hierarchy.
        strHierarchy = Left(strSel, i - 1)
        Exit For
      End If
  Next i
  
you SHOULD find it works

---------- FOLLOW-UP ----------

QUESTION: What exactly did you change it to? I cannot find the difference.

Thanks,
David

ANSWER: It's one extra line - the

Exit For

says that when you have found a space - stop looking for any more.  It could equally go in here

For i = 1 To Len(strHierarchy)
      If Mid(strHierarchy, i, 1) = "." Then   ' Count the "." (s)
        intDotCount = intDotCount + 1
      End If
  Next i


In this case it would say

For i = 1 To Len(strHierarchy)
      If Mid(strHierarchy, i, 1) = "." Then   ' Count the "." (s)
        intDotCount = intDotCount + 1
      elseif mid(strhierarchy,i,1)=" " then exit for  
      End If
  Next i

---------- FOLLOW-UP ----------

QUESTION: I spoke to soon. It was a great idea, but when I ran the macro, it did not work at all. Usually, at least the names with "."'s in them would be calculated; however, this time, nothing was calculated, and everything remained the same heading. What else can be done?

Answer
Did you try taking out that change and putting in my second suggestion?

For i = 1 To Len(strHierarchy)
     If Mid(strHierarchy, i, 1) = "." Then   ' Count the "." (s)
       intDotCount = intDotCount + 1
     elseif mid(strhierarchy,i,1)=" " then exit for  
     End If
 Next i



I have slight problems in that when I run the macro it does nothing - but it may be the type of document/system settings on my machine that are at fault.
About Microsoft Word
This topic answers questions related to Microsoft Word stand-alone or Microsoft Office Word including Word 2003, Word 2007, Office 2000, and Office XP. You can get Word help on formatting text, tables, tabs, fonts, styles, general Word layouts, bullets, headings, and outlines, using templates, toolbar modifications, and using Track Changes. You may also find tips on linking Word and Excel embedded objects including charts. This site does not provide a general Word tutorial nor the basics of using a word processor. It provides specific answers to using Microsoft Word only. If you do not see your Word question answered in this area then please ask a Word question here

Microsoft Word

All Answers


Answers by Expert:


Ask Experts

Volunteer


Aidan Heritage

Expertise

I have provided first hand support since `95 for Microsoft Office majoring in Word and Excel - support for all versions of Word from 2 onwards

©2016 About.com. All rights reserved.