View Single Post
 
Old 05-28-2024, 02:10 PM
gmaxey gmaxey is offline Windows 10 Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,617
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

Here is one way:


Code:
Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oTbl As Table
Dim lngIndex As Long
Dim colBMs As New Collection
Dim oBM As Bookmark
Dim strBMName As String
Dim oRNg As Range
Dim bValid As Boolean
  'Get the collection of existing bookmarks
  For Each oBM In ActiveDocument.Bookmarks
    colBMs.Add oBM.Name, oBM.Name
  Next oBM
  Set oTbl = Selection.Tables(1)
  bValid = True
  For lngIndex = 1 To oTbl.Rows.Count
    Set oRNg = oTbl.Cell(lngIndex, 1).Range
    If oRNg.InRange(Selection.Range) Then
      oRNg.End = oRNg.End - 1
      strBMName = fcnValidateBMName(oRNg.Text)
      On Error Resume Next
      colBMs.Add strBMName, strBMName
      If Err.Number = 0 Then
        ActiveDocument.Bookmarks.Add strBMName, oRNg
      Else
         oTbl.Cell(lngIndex, 1).Range.Shading.BackgroundPatternColor = wdColorRed
         bValid = False
      End If
      On Error GoTo 0
    End If
  Next lngIndex
  If bValid Then
    MsgBox "Processing complete."
  Else
    MsgBox "Processing complete. One or more rows could not be bookmarked due to a duplicate name."
  End If
lbl_Exit:
  Exit Sub
End Sub

Function fcnValidateBMName(strIn As String) As String
  strIn = Trim(strIn)
  strIn = Replace(strIn, " ", "_")
  If IsNumeric(Left(strIn, 1)) Then
    strIn = "_" & strIn
  End If
  fcnValidateBMName = strIn
End Function
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote