#1
|
|||
|
|||
Add bookmark for each Headings
I have a TOC with heading 1, which works fine. I am trying to get it through Smashwords but they tell me not to use Word's TOC field codes so I need to convert the TOC to standard hyperlinks and there are a lot of them. Is it possible to use a macro to
add bookmarks to all the headings ? |
#2
|
||||
|
||||
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thanks but this was way off.
|
#4
|
||||
|
||||
The macro in that link does exactly what you say you're trying to achieve, by converting a standard Word Table of Contents to a hyperlinked list.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
I took another look and saw that the existing TOC was still there and behaving strangely but at the top of the document I did find all the items linked, 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. 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.
|
#6
|
||||
|
||||
Quote:
I have no idea what that is supposed to mean. Quote:
Quote:
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
REf Fields show Bookmark whole cell when Bookmark is created by code. | pmcpowell | Word VBA | 2 | 11-16-2019 07:05 PM |
Applied Styles to Headings in Multi-Level List; now ALL second level headings are 1.XX | NNL | Word | 1 | 08-09-2017 02:52 PM |
Numbered headings not working as expected after customising headings | seanspotatobusiness | Word | 5 | 03-03-2017 04:44 AM |
Find Bookmark, move to bookmark, execute code, repeat | raymm3852 | Word VBA | 10 | 04-15-2016 06:21 PM |
Bookmark error in TOC when headings replaced | larrylandis01 | Word | 4 | 04-08-2016 04:52 PM |