Steven McCrary
Steven McCrary

Reputation: 1

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
'--------------------------------------------------------------------------  

Upvotes: 0

Views: 197

Answers (2)

Steven McCrary
Steven McCrary

Reputation: 1

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

Upvotes: 0

macropod
macropod

Reputation: 13490

That's truly horrible code you're using. Try:

Sub BkMkDemo()
Application.ScreenUpdating = False
Dim r As Long, BkMkNm As String, BkMkTxt As String
With ActiveDocument
  For r = 2 To .Tables(1).Rows.Count
    BkMkNm = Split(.Tables(1).Cell(r, 1).Range.Text, vbCr)(0)
    BkMkTxt = Split(.Tables(1).Cell(r, 2).Range.Text, vbCr)(0)
    If Not .Bookmarks.Exists(BkMkNm) Then .Bookmarks.Add BkMkNm, .Range.Characters.Last
    Call UpdateBookmark(BkMkNm, BkMkTxt)
  Next
End With
Application.ScreenUpdating = True
End Sub

Sub UpdateBookmark(BkMkNm As String, BkMkTxt As String)
Dim BkMkRng As Range
With ActiveDocument
  If .Bookmarks.Exists(BkMkNm) Then
    Set BkMkRng = .Bookmarks(BkMkNm).Range
    BkMkRng.Text = BkMkTxt
    .Bookmarks.Add BkMkNm, BkMkRng
  End If
End With
Set BkMkRng = Nothing
End Sub

If all you want to do is to apply the bookmark to the content of the second cell, you need nothing more complex than:

Sub BkMkDemo()
Application.ScreenUpdating = False
Dim r As Long, BkMkNm As String, BkMkRng As Range
With ActiveDocument
  For r = 2 To .Tables(1).Rows.Count
    BkMkNm = Split(.Tables(1).Cell(r, 1).Range.Text, vbCr)(0)
    Set BkMkRng = .Tables(1).Cell(r, 2).Range
    BkMkRng.End = BkMkRng.End - 1
    .Bookmarks.Add BkMkNm, BkMkRng
  Next
End With
Application.ScreenUpdating = True
End Sub

Upvotes: 0

Related Questions