Search code examples
vbams-wordbookmarks

Create bookmark via selected text?


I'm trying to create a macro that will create a location bookmark at the location and the name of the selected text.

I have the code below, and it's saying the bookmark name is bad.

 Sub AddBookMark()

 Dim sText As String
 sText = Application.Selection.Text
 sText = Replace(sText, vbCrLf, "")
 sText = Replace(sText, Chr(10), " ")
 sText = Replace(sText, Chr(182), " ")

With ActiveDocument.Bookmarks
    .Add Range:=Selection.Range, Name:=sText
    .DefaultSorting = wdSortByName
    .ShowHidden = False
End With
End Sub

Is there any way to set the bookmark name as a variable based on the selected text?


Solution

  • Try this

    Tested it with a string like "@#$1_qwerty@#@!# _1234". The CleanText function will change it to "qwerty_1234"

    A bookmark Name will accept a-z/A-Z as the 1st Character and a-z/A-Z/0-1/_ as the rest.

    Option Explicit
    
     Sub AddBookMark()
        Dim sText As String
    
        sText = CleanText(Application.Selection.Text)
    
        If sText = "" Then
            MsgBox "Invalid Name"
            Exit Sub
        End If
    
        With ActiveDocument.Bookmarks
            .Add Range:=Selection.Range, Name:=sText
            .DefaultSorting = wdSortByName
            .ShowHidden = False
        End With
    End Sub
    
    Function CleanText(strInput As String) As String
        Dim i As Long, strTemp As String
    
        strInput = Trim(strInput)
    
        Do Until (Asc(Left(strInput, 1)) > 65 And Asc(Left(strInput, 1)) < 90) Or _
        (Asc(Left(strInput, 1)) > 97 And Asc(Left(strInput, 1)) < 122) Or Len(strInput) = 0
            Select Case Asc(Left(strInput, 1))
                Case 65 To 90, 97 To 122
                Case Else: strInput = Mid(strInput, 2)
            End Select
        Loop
    
        strTemp = Left(strInput, 1)
    
        For i = 2 To Len(strInput)
            Select Case Asc(Mid(strInput, i, 1))
                Case 65 To 90, 97 To 122, 95, 48 To 57
                    strTemp = strTemp & Mid(strInput, i, 1)
            End Select
        Next
    ExitF:
        CleanText = strTemp
    End Function