vbams-wordbookmarksword-table

How to clean a Word table before saving to a Word bookmark?


I am writing Word VBA that:
(1) assigns values from a Word table to VBA variables,
(2) cleans the variables' values of non-text,
(3) uses the variables' names and values to create Bookmarks in that same bookmark_value cell of the table, and
(4) repeats 1-2-3 until the end of table.

This table is the first table in the document and has two columns, something like this:

_________________________________
| bookmark_name | bookmark_value| 
|     bm1       |      88       | 
|     foo       |      66       | 
|_____bar_______|______44_______| 

The code picks up the bookmark_names and posts into Word Bookmarks, and also picks up the bookmark_values but fails to clean the table coding out of the value.
The result is the Bookmarks displaying these unwanted cells in Word with the value inside it. It is strange that first column works and not the second.

Some things I tried:
I found on the Internet and on this site, what I thought were solutions, those are marked in the code below with comments, the header saying, "tried and failed".
I am nearly sure I need to "unformat" the text, or something like that.

Public Sub BookmarkTable()
    Dim selectedTable As Table
    Dim curRow As Range
    Dim rngSelect1 As Range
    Dim rngSelect2 As Range
    Dim intTableIndex As Integer
    Dim rng As Range
    Dim Cell1 As Cell, Cell2 As Cell
    Dim strBookmarkName As String, strBookmarkValue As String, strBV As String
    Dim strTstBookmark As String
    Dim Col1 As Integer, Col2 As Integer
    Dim i As Integer, t As Integer
    Dim intRow As Integer
    '    Dim
    Col1 = 1   'set the bookmark name from column 1
    Col2 = 2   'set the bookmark's value from column 2

    'For t = 1 To ActiveDocument.Tables.Count

    t = 1  'select the Table to use(only using the first table right now)
            
    Set selectedTable = ActiveDocument.Tables(t)
    selectedTable.Select                       'selects the table
            
    For intRow = 2 To selectedTable.Rows.Count   'iterate through all rows
    
        If Selection.Information(wdWithInTable) Then
            Set Cell1 = ActiveDocument.Tables(t).Cell(intRow, Col1)
            Set Cell2 = ActiveDocument.Tables(t).Cell(intRow, Col2)
            Cell2.Select
            intTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
            rngColumnStart = Selection.Information(wdStartOfRangeColumnNumber)
            rngRowStart = Selection.Information(wdStartOfRangeRowNumber)        
        End If
                    
        strTstBookmark = "BM_Table" & CStr(intTableIndex) & "_R" & CStr(rngRowStart) & "_C" & CStr(rngColumnStart)
        ' strBookmarkValue = strTstBookmark
        Set rngSelect1 = ActiveDocument.Range(Start:=Cell1.Range.Start, End:=Cell1.Range.End - 1)
        strBookmarkName = Strip(rngSelect1.Text)
        Set rngSelect2 = ActiveDocument.Range(Start:=Cell2.Range.Start, End:=Cell2.Range.End - 1)
        strBookmarkValue = Strip(rngSelect2.Text)
    
        Set rng = ActiveDocument.Tables(intTableIndex).Cell(rngRowStart, rngColumnStart).Range
        rng.End = rng.End - 1
                
        '--------------------------------------------------------------------------
        'tried and failed)
        '--------------------------------------------------------------------------
        'Stop
        If ActiveDocument.Bookmarks.Exists(strBookmarkName) = True Then
            ActiveDocument.Bookmarks(strBookmarkName).Delete
        End If
        If ActiveDocument.Bookmarks.Exists(strTstBookmark) = True Then
            ActiveDocument.Bookmark(strTstBookmark).Delete
        End If
                
        ActiveDocument.Bookmarks.Add Name:=strTstBookmark
        ActiveDocument.Bookmarks.Add Name:=strBookmarkName
        ActiveDocument.Bookmarks(strBookmarkName).Range.Text =  strBookmarkValue
              
    Next intRow

    'Next t
End Sub

'--------------------------------------------------------------------------
'tried and failed
Private Function Strip(ByVal fullest As String)
    '  fuller = Left(fullest, Len(s) - 2)
    Strip = Trim(Replace(fullest, vbCr & Chr(7), ""))  
End Function
'--------------------------------------------------------------------------  

Solution

  • After a great deal of research and learning by this VBA neophyte, here is the solution that I finally got to work. I found the fix by accident on the Windows Dev Center at msdn dot microsoft dot com posted by Cindy Meister...thank you. Turns out there are a combination of three characters needing to be cleaned when extracting text from a Word table cell: Chr(10) & Chr(13), Chr(11).

    I simplified the code using the suggestions of macropod above. Thank you.

        Sub aBookmarkTable()
        '
        'a subroutine compiled by Steven McCrary from various sources
        'on the Internet, to use values in the second column of the 
        'first table in a Word document to create Bookmarks in that second 
        'column, in place of the value input there.
        '
        'To use the macros, modify the values in the table and run the macro.
        'Then place Field Code references in Word to use the Bookmarks.
        'The Bookmarks can be seen through Word menu: Insert>Links>Bookmark
        '
        'The table has just two columns, looking something like this:
        '_________________________________
        '| bookmark_name | bookmark_value|
        '|     bm1       |      88       |
        '|     foo       |      66       |
        '|_____bar_______|______44_______|
        '
        'The code places each Bookmark in the second column of each row, using
        'the name given in the first column.
        '
        'The two critical functions of the macro occur in these two lines of code:
        ' rngBM.End = rngBM.End - 1
        ' Strip = Replace(fullest, Chr(10) & Chr(13), Chr(11))
        '
        ' both are explained below where they are used.
        
          Application.ScreenUpdating = False
            Dim rng1 As Range, rng2 As Range, rngBM As Range
            Dim Cell_1 As Cell, Cell_2 As Cell
            Dim strBMName As String, strBMValue As String
            Dim r As Integer
            
            Call RemoveBookmarks 'removing bookmarks helped to simlify the coding
            
            With ActiveDocument
                For r = 2 To .Tables(1).Rows.Count   'iterate through all rows
                    Set Cell_1 = ActiveDocument.Tables(1).Cell(r, 1)
                    Set Cell_2 = ActiveDocument.Tables(1).Cell(r, 2)
                    Cell_2.Select
                    
                    Set rng1 = .Range(Cell_1.Range.Start, Cell_1.Range.End - 1)
                    strBMName = Strip(rng1.Text)
                    
                    Set rng2 = .Range(Cell_2.Range.Start, Cell_2.Range.End - 1)
                    Set rngBM = ActiveDocument.Tables(1).Cell(r, 2).Range
    
                   'When using data contained in a cell of a Word table, 
                   'grabbing the cell's contents also grabs several other 
                   'characters, which therefore need removed in two steps.  
                   '
                   'The first step is to clean the extra characters from the text.
                    strBMValue = Strip(rng2.Text)  
                    '
                    'The second step is to decrease the range size to put in the 
                    'Bookmark.
                    rngBM.End = rngBM.End - 1
                    rngBM.Text = strBMValue
        
                    .Bookmarks.Add strBMName, rngBM
                Next r
             End With
          Application.ScreenUpdating = True
          Selection.WholeStory
          ActiveDocument.Fields.Update
        End Sub
        
        Sub RemoveBookmarks()
        Dim bkm As Bookmark
        For Each bkm In ActiveDocument.Bookmarks
        bkm.Delete
        Next bkm
        End Sub
        Private Function Strip(ByVal fullest As String)
           '  the next line of code is the tricky part of the clean 
           '  process because of how Word formats tables and text  
           '  ASCII code Chr(10) is Line Feed  
           '  Chr(13) is Carriage Return  
           '  Chr(13) + Chr(10): vbCrLf or vbNewLine New line character  
           '  Chr (11) is Vertical Tab, but per Word VBA Manual -  
           '  manual line break (Shift + Enter)  
    '
           Strip = Replace(fullest, Chr(10) & Chr(13), Chr(11))
        
        End Function  
    

    Thank you again. SWM