Share via

create bookmarks based on style

Anonymous
2011-03-22T08:50:26+00:00

I have written a macro that created bookmarks based on style and is working great the macro is the following :

Dim i As Long

  Dim j As Long

  i = 0

  selection.HomeKey wdStory

  With selection.Find

    .Style = ActiveDocument.styles("AIO")

    Do While .Execute(findtext:="", Forward:=True, _

        MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True

      i = i + 1

      ActiveDocument.bookmarks.Add "AA_BD" & i, selection.Range

      selection.Collapse wdCollapseEnd

    Loop

  End With

the thing is that sometimes the style is available in another style example :

a paragraph might have a style of " pop " applyed to it , and in the middle of it , a word or a line has the style "AIO" applyed to it while running the macro  , i cant get to create a bookmark in this case

any help please ?

Microsoft 365 and Office | Word | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments No comments

Answer accepted by question author

Paul Edstein 82,861 Reputation points Volunteer Moderator
2011-03-22T09:40:42+00:00

Hi Anfy,

Try something along the lines of:

Sub AutoBkMk()

Dim i As Long, oSty As Style, fRng As Range

i = 0

With ActiveDocument

  For Each oSty In .Styles

    If InStr(oSty.NameLocal, "AIO") > 0 Then

      With .Range

        With .Find

          .Style = oSty.NameLocal

          .Text = ""

          .Forward = True

          .MatchWildcards = False

          .Wrap = wdFindStop

          .MatchCase = False

          .Execute

        End With

        Do While .Find.Found

          i = i + 1

          Set fRng = .Duplicate

          With fRng

            ActiveDocument.Bookmarks.Add "AA_BD" & i, fRng

            .Collapse Direction:=wdCollapseEnd

          End With

          .Find.Execute

        Loop

      End With

    End If

  Next

End With

Set fRng = Nothing

End Sub

Was this answer helpful?

0 comments No comments

0 additional answers

Sort by: Most helpful