Consulting

Results 1 to 7 of 7

Thread: Create automatic index in Word based on Headings with VBA

  1. #1

    Post Create automatic index in Word based on Headings with VBA

    Hi,

    I've made family cookbook in Word and with every new item I'm able to renew the TOC with that new item (recipe). The items in the TOC also have hyperlinks to the specific recipe and every Heading has a hyperlink, that brings you back to the TOC. However, all the recipes are added after the last recipe and this makes the TOC difficult to read.
    I would like to create an alphabetical index at the end of my document, with all the headings of recipes and respective pages, and the index items also hyperlinked to the recipes.
    I'm a bit at a loss how to do this. I can mark a heading for an index. But how to do this in VBA? Also to mark the index item as an hyperlink?

    I would appreciate your help.

    I've added the TOC macro below:
    Sub UpdateTOC()
    ' Update TOC and hyperlinks Macro
    Application.ScreenUpdating = False
    Dim hyp As Hyperlink
    Dim toc As TableOfContents
    Dim k As Long
    Dim bkmk As String
    Dim sCode As String
    Dim fld As Field
    Dim aRange As Range
    If ActiveDocument.TablesOfContents.Count = 0 Then
        MsgBox "There are no Tables of Contents in document"
        Exit Sub
    End If
    If ActiveDocument.TablesOfContents.Count = 1 Then _
       ActiveDocument.TablesOfContents(1).Update
       Set toc = ActiveDocument.TablesOfContents(1)
       For Each fld In toc.Range.Fields
          sCode = fld.Code.Text
          If InStr(sCode, "HYPERLINK") > 0 Then
    bkmk = Mid(sCode, InStr(sCode, "_"))
    bkmk = Left(bkmk, Len(bkmk) - 2)
    fld.Select
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
    Name:=bkmk & "R" Set aRange = ActiveDocument.Bookmarks(bkmk).Range
    aRange.Select
    With ActiveDocument.Hyperlinks.Add(Anchor:=Selection.Range, _
    Address:="", SubAddress:=bkmk & "R", _
    TextToDisplay:=Selection.Text)
    .Range.Select
    Selection.ClearCharacterAllFormatting
    End With End If Next fld Options.CtrlClickHyperlinkToOpen = False
    Selection.GoTo What:=wdGoToBookmark, Name:="Inhoud" Application.ScreenUpdating = True End Sub
    Last edited by Aussiebear; 03-05-2023 at 06:04 AM. Reason: Added code tags to wrap the submitted code

  2. #2
    VBAX Contributor
    Joined
    Jul 2020
    Location
    Sun Prairie
    Posts
    123
    Location
    The Table of Contents and the Index are different fields and the Index field does not have hyperlink capability built into it.
    I believe you can find macros to assign hyperlinks to an Index in the Word vba forum.

  3. #3
    Quote Originally Posted by Chas Kenyon View Post
    The Table of Contents and the Index are different fields and the Index field does not have hyperlink capability built into it.
    I believe you can find macros to assign hyperlinks to an Index in the Word vba forum.
    Dear Chas,
    Thanks for replying. I know that TOC and Index are different. The macro I submitted makes an automatic TOC with hyperlinks. However, since the added recipes are not added in alphabetical order, it becomes difficult to search. Therefor I would like to add an Index. This is automatically alphabetical. But I'm looking for a macro to transform every heading into an Index item and then create an Index with hyperlinks.
    If you know where to find the macro to assign hyperlinks to an Index...?
    Greetings, johan

  4. #4
    Hi everyone, I could use some more help on this one...

  5. #5
    VBAX Newbie
    Joined
    Jun 2024
    Posts
    1
    Location
    Hi, I could use help with accomplishing this exact thing. Did anyone ever come up with the macro that could do it? TIA

  6. #6
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,189
    Location
    A fellow VBAX 'er Macropod, came up with this concept
    You could create a Table of Contents, convert that to a table, then sort the table. The following macro does just that:

    Sub CreateIndexTable()
        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:=Selection.Range, 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:=2)
        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 = 90
            End With
            With .Columns(2)
                .PreferredWidthType = wdPreferredWidthPercent
                .PreferredWidth = 10
            End With
            With .Cell(1, 1).Range
                .Text = "Poem"
            End With
            With .Cell(1, 2).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 & " \h", PreserveFormatting:=False
            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:="PAGEREF " & StrTmp & " \h", PreserveFormatting:=False
                .ParagraphFormat.Alignment = wdAlignParagraphRight
            End With
       Next
       Tbl.Range.Fields.Update
       Tbl.Sort ExcludeHeader:=True, FieldNumber:=1, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
       End With
    End Sub
    Note: If you add/delete headings, you'll need to delete the table & run the macro again.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  7. #7
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,189
    Location
    Well it appears that assistance went to the dogs....
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •