#1
|
|||
|
|||
Table of Contents causes error when checking style
I have a macro that loops through each paragraph in a document and finds a particular style. It then takes that text, and puts it in an array. So far so good. Where I came unstuck is with a table of contents which has no style. It causes an error.
I have trimmed down the function as it is much more complex than the one below, but hopefully this will provide the basis to understand the problem. How do I cater for hitting a ToC with no style when looping through the document? Public Function funGetHeadingFromStyle(ByVal strStyleToFind As String) As String Dim rngCurrentRange As Range Dim blnWholeDocumentSearched As Boolean Dim blnHeadingFound As Boolean Dim intHeadersFound Dim strTest As String '--------------------------------------------------------------- ' Initialise the variables Set rngCurrentRange = Selection.Range blnWholeDocumentSearched = False blnHeadingFound = False intHeadersFound = 0 Do Until blnWholeDocumentSearched ' Loop until you reach the end of the document If rngCurrentRange.Style = strStyleToFind Then ' Found a heading strTest = Trim(rngCurrentRange.Text) strTest = Left(strTest, Len(strTest) - 1) ' Remove paragraph mark ' Add a comma if it is not the first header If intHeadersFound > 0 Then funGetHeadingFromStyle = funGetHeadingFromStyle & ", " End If ' Store the header text funGetHeadingFromStyle = funGetHeadingFromStyle & strTest ' Update the counter - number of headers found intHeadersFound = intHeadersFound + 1 ' Number of records found End If Set rngCurrentRange = rngCurrentRange.Next(wdParagraph, 1) ' Select the next paragraph blnWholeDocumentSearched = ActiveDocument.Range(0, rngCurrentRange.Paragraphs(1).Range.End).Paragraph s.Count = 0 ' End of the document Loop End Function |
#2
|
|||
|
|||
It may be that you don't need a macro at all. This is because Word allows you to build a Table of Contents using any style or set of styles that exist in your document. To do this you need to use the \t switch in the TOC field
https://support.office.com/en-us/art...rs=en-US&ad=US For example, if you wanted to construct a TOC using the style 'myStyle1' and 'myStyle2' you would use the \t switch in the following way { toc \t "myStyle1,1,myStyle2,2" } The number that follows the style tells word which TOC style to use when compiling the TOC. This in the above example the 'myStyle1' headings would appear in the TOC using 'TOC 1' style for 'myStyle1' and 'TOC 2' style for 'myStyle2' . |
#3
|
|||
|
|||
Thanks for the suggestion but I have already generated a ToC using a macro. This is for another reason. Just need to cater for the situation where someone elects to create a ToC then run this macro after.
|
#4
|
|||
|
|||
What do you mean that a TOC has no style? Every paragraph in document has a style.
You are not putting anything in an array. Your functions returns a string value not an array. You might try: Code:
Sub Test() MsgBox funGetHeadingFromStyle("Heading 1") End Sub Public Function funGetHeadingFromStyle(ByVal strStyleToFind As String) As String Dim oPar As Paragraph Dim lngIndex As Long For Each oPar In ActiveDocument.Paragraphs If oPar.Style = strStyleToFind Then If lngIndex = 0 Then funGetHeadingFromStyle = Left(oPar.Range.Text, Len(oPar.Range.Text) - 1) Else funGetHeadingFromStyle = funGetHeadingFromStyle & ", " & Left(oPar.Range.Text, Len(oPar.Range.Text) - 1) End If lngIndex = lngIndex + 1 End If Next End Function |
#5
|
|||
|
|||
Hi Greg. Sorry to disagree, but when I loop through the document, and it gets to ToC, if I hover over the field, it says the style is nothing. I have worked around that now by using "On Error Goto..." and continue the loop.
Regarding the array, I have not gotten to that yet. My understanding is that you use a string with comma delimiters. Is that correct? The approach you used works perfectly now. Did away with the do until/loop approach and replaced it with for/next. Working perfectly now. I will look at the use of the array in the next few days. Thanks Greg |
#6
|
||||
|
||||
The style says nothing if there is a mixture of styles in the selection/range you are testing. In a TOC, a paragraph will have a 'TOC x' paragraph style and often a hyperlink character style applied over it.
Perhaps you should explain why you want the result returned as an array?
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
|||
|
|||
That explains the "nothing" format.
I have a particular type of document that requires a table with two columns. "Topic" and "See Page". It is sort of a ToC but it has to be in this format. I now have your code working properly so can move onto the table when I get a chance over the next few days. My thinking is that I can find the number of items in the array, and create a table with that number + 1 rows. The top row is the header. I can then populate the left-hand column from the array. I will create a cross-reference in the right-hand column. It sounds a lot of work when Word has options for different ToC but that is what is required. On another level, it is a learning exercise which I enjoy. I have used VBA in Access for decades and consider myself well above average but Word is a whole new ballgame. Glad you have been able to assist. I appreciate your help. |
#8
|
||||
|
||||
In that case, you are approaching this the wrong way. The array is achieving nothing for you.
My concept of the macro is: 1. Use Greg's code to find each instance and tag the text with an incrementing bookmark name eg head1, head2, head3 2. Create the table 3. Loop through rows 2 onwards. In cell 1 put in a field {Ref head1}. In cell 2 put in a field {PageRef head1}. Increment the bookmark name on each subsequent row Job done
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#9
|
|||
|
|||
Or why don't you let Word use it own will to create the TOC and then use your will (aka macro) to make a table out of the TOC:
Code:
Sub ScratchMacro() Dim oRng As Range Dim oTbl As Table Set oRng = Selection.Fields.Add(Selection.Range, wdFieldTOC).Result oRng.Fields(1).Unlink Set oTbl = oRng.ConvertToTable(vbTab) With oTbl .Rows.Add BeforeRow:=oTbl.Rows(1) .Cell(1, 1).Range.Text = "Topic" .Cell(1, 2).Range.Text = "See Page" .Columns(2).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight .Borders.OutsideLineStyle = wdLineStyleSingle End With oRng.Select Selection.Collapse wdCollapseEnd lbl_Exit: Exit Sub End Sub |
#10
|
||||
|
||||
Greg
I thought about that but I thought that he might want the hyperlinks on both columns of the 'TOC'. Your solution looked too good to be true and there is some weirdness there that may not be fixable. Unlinking the first field actually retains the TOC field and unlinks the page number hyperlink from the first TOC entry (ie the first field inside the TOC field). If you then try to reveal the field codes or update the field, the table disappears and the fresh TOC reappears.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#11
|
|||
|
|||
The result of a toc field will contain a collection of fields which are the hyperlinks and page references of the TOC.
e.g. <expression returning a range>.field(<field_index>).result.fields.count or in the terms of the last code example oRng.fields.count Therefore you can iterate though this collection and obtain the hyperlinks and pagerefs at your leisure without having to convert the toc to a table. Dim myField as word.field For each myField in oRng.Fields if myField.type = wdfieldhyperlink then ' do something etc etc |
#12
|
|||
|
|||
The reason for converting the TOC to a table is because the original poster wants a table in a specific format not a TOC.
Guessed, I think this could resolve the issue you mentioned. Just don't delete any field: Code:
Sub ScratchMacro() Dim oRng As Range Dim oTbl As Table Set oRng = Selection.Fields.Add(Selection.Range, wdFieldTOC).Result Set oTbl = oRng.ConvertToTable(vbTab) With oTbl .Rows.Add BeforeRow:=oTbl.Rows(1) .Cell(1, 1).Range.Text = "Topic" .Cell(1, 2).Range.Text = "See Page" .Columns(2).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight .Borders.OutsideLineStyle = wdLineStyleSingle End With oRng.Select Selection.Collapse wdCollapseEnd lbl_Exit: Exit Sub End Sub |
#13
|
|||
|
|||
Very impressive Greg. A neat piece of code.
There is one twist I didn't mention. I only want to list Heading 4 in the table. |
#14
|
||||
|
||||
NevilleT
It doesn't take a big mod to change the TOC to only list Heading 4 Change the line that says Set oRng = Selection.Fields.Add(Selection.Range, wdFieldTOC).Result to Set oRng = Selection.Fields.Add(Range:=Selection.Range, Text:="TOC \o 4-4").Result I would also recommend you add a line at the end to lock the TOC field because you won't want it updating
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#15
|
|||
|
|||
Brilliant. All working now. Added a few formatting things to it. This is the final code. Thanks to all who helped.
Sub ScratchMacro() Dim oRng As Range Dim oTbl As Table Set oRng = Selection.Fields.Add(Range:=Selection.Range, Text:="TOC \o 4-4").Result Set oTbl = oRng.ConvertToTable(vbTab) With oTbl .Rows.Add BeforeRow:=oTbl.Rows(1) .Cell(1, 1).Range.Text = "Topic" .Cell(1, 2).Range.Text = "See Page" .Columns(2).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight .Borders.OutsideLineStyle = wdLineStyleSingle .Columns(1).Width = 290 .Columns(2).Width = 80 .Rows(1).Range.Bold = True .Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter .Rows(1).Shading.BackgroundPatternColor = wdColorGray25 End With oRng.Select Selection.Collapse wdCollapseEnd lbl_Exit: Exit Sub End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Table of contents vs headings: what style settings need to be changed? | boxhamster | Word | 5 | 08-15-2015 03:25 PM |
LaTeX style table of contents in MS Word | MichaelHenrotte | Word | 1 | 11-23-2014 03:16 AM |
Creating Table of Contents From a Custom Style | Jetheat | Word | 4 | 12-15-2013 03:54 PM |
How to have this Heading – Table of contents style? | Jamal NUMAN | Word | 0 | 01-13-2011 06:02 PM |
Word 2003 Table of Contents Error Message | ktcolburn | Word | 1 | 10-30-2005 06:14 PM |