Microsoft Office Forums - View Single Post

macropod · 07-10-2025, 03:50 PM

For example:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, StrBkMk As String
Dim StrNoChr As String: StrNoChr = """‘'’“”*!.,/\:;?|{}[]()&" & vbCr & Chr(11) & Chr(12) & vbTab
With ActiveDocument.Range
  For i = .Bookmarks.Count To 1 Step -1
    With .Bookmarks(i)
      If Left(.Name, 1) = "_" Then If Right(.Name, 3) Like "###" Then .Delete
    End With
  Next
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Style = "myStyle"
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
  End With
  Do While .Find.Execute
    StrBkMk = Replace(Trim(.Text), " ", "_")
    For j = 1 To Len(StrNoChr): StrBkMk = Replace(StrBkMk, Mid(StrNoChr, j, 1), ""): Next
    i = i + 1: .Bookmarks.Add "_" & Left(StrBkMk, 36) & Format(i, "000"): .Collapse wdCollapseEnd
    If .Information(wdWithInTable) = True Then
      If .End = .Cells(1).Range.End - 1 Then
        .End = .Cells(1).Range.End
        .Collapse wdCollapseEnd
        If .Information(wdAtEndOfRowMarker) = True Then
          .End = .End + 1
        End If
      End If
    End If
    .Collapse wdCollapseEnd
    If (ActiveDocument.Range.End - .End) < 2 Then Exit Do
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " bookmarks added."
End Sub

Do note that the inserted bookmarks are hidden and numbered. That's because:
• bookmarks cannot begin with numbers; and
• bookmark names must be unique. Numbering them obviates the potential for duplicate names
Making the bookmarks hidden prefixes them with an underscore, which avoids the first problem, whilst numbering avoids the second problem. Changing the prefix character to something else will make the bookmarks visible.

As coded, the macro will replace any of the existing bookmarks it has previously inserted on each run.

Given that you're using Hebrew, you might need to change:
Left(StrBkMk, 36)
to:
Right(StrBkMk, 36)