Quote:
Originally Posted by delboy
I took another look and saw that the existing TOC was still there ... but at the top of the document I did find all the items linked
|
Not unless you had
two Tables of Contents - only the first one is converted. All that remains of that one is a set of hyperlinks formatted to look like the original.
Quote:
Originally Posted by delboy
the existing TOC was still there and behaving strangely
|
I have no idea what that is supposed to mean.
Quote:
Originally Posted by delboy
the only thing is they are no longer in a list but packed together without spaces. That is not a problem as I can separate them.
|
Since the code re-applies the original TOC Styles, separating each entry with a paragraph break, that outcome can only be because that is how those Styles are defined.
Quote:
Originally Posted by delboy
The only problem now is I would like to be able to sort the new list but the sort function doesn't seem to work on it.
|
In which case you should have said so at the outset. Try the following which converts the TOC to a sorted table of hyperlinks. You can convert the table back to text if you wish.
Code:
Sub ConvertTOC2Table()
Dim TOC As TableOfContents, Rng As Range, Tbl As Table
Dim StrBkMkList As String, StrStlList As String, StrTmp As String, i As Long
With ActiveDocument
If .Bookmarks.Exists("TblTOC") Then
.Bookmarks("TblTOC").Range.Delete
.Bookmarks("TblTOC").Delete
End If
Set TOC = .TablesOfContents.Add(Range:=.Range(0, 0), UseHeadingStyles:=True, IncludePageNumbers:=True)
With TOC
For i = 3 To .Range.Fields.Count
StrBkMkList = StrBkMkList & "|" & Split(Trim(.Range.Fields(i).Code.Text), " ")(1)
StrStlList = StrStlList & "|" & .Range.Paragraphs(i - 2).Style
Next
Set Rng = .Range
.Delete
End With
Set Tbl = .Tables.Add(Range:=Rng, NumRows:=i - 2, NumColumns:=3)
With Tbl
.Borders.Enable = True
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 90
.Rows.Alignment = wdAlignRowCenter
.Rows(1).HeadingFormat = True
.Rows(1).Range.Style = "Strong"
With .Columns(1)
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 10
End With
With .Columns(2)
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 70
End With
With .Columns(3)
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 10
End With
With .Cell(1, 1).Range
.Text = "Section"
End With
With .Cell(1, 2).Range
.Text = "Subject"
End With
With .Cell(1, 3).Range
.Text = "Page"
End With
End With
For i = 1 To UBound(Split(StrBkMkList, "|"))
StrTmp = Replace(Split(StrBkMkList, "|")(i), "Toc", "TblTOC")
.Bookmarks.Add Name:=StrTmp, Range:=.Bookmarks(Split(StrBkMkList, "|")(i)).Range
.Bookmarks(Split(StrBkMkList, "|")(i)).Delete
Set Rng = Tbl.Cell(i + 1, 1).Range
With Rng
.Style = Split(StrStlList, "|")(i)
.End = .End - 1
.Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:="REF " & StrTmp & " \r \h", PreserveFormatting:=False
.InsertBefore vbTab
End With
Set Rng = Tbl.Cell(i + 1, 2).Range
With Rng
.Style = Split(StrStlList, "|")(i)
.End = .End - 1
.Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:="REF " & StrTmp & " \h", PreserveFormatting:=False
End With
Set Rng = Tbl.Cell(i + 1, 3).Range
With Rng
.Style = Split(StrStlList, "|")(i)
.End = .End - 1
.Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:="PAGEREF " & StrTmp & " \h", PreserveFormatting:=False
.InsertBefore vbTab
End With
Tbl.Range.Fields.Update
'To not sort the table by topic/subject, comment out the next line
Tbl.Sort ExcludeHeader:=True, FieldNumber:=2, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
'To convert the table back to text, uncomment the next line
'Tbl.ConvertToText Separator:=vbTab
Next
End With
End Sub