Creating tables at bookmarks in a Word document through Excel VBA from dynamic controls

keaden

New Member
Joined
Sep 29, 2010
Messages
26
All,
I'm hoping someone can help me on this as I have been banging my head against this for about a week or so.

I have a userform that creates a set of controls (3 text boxes and a combo box) and interates a counter by 1 each time the button is pressed.

I have written an Excel VBA Macro that should open up a specific document (which will be a dotx in the final version but is a docx for this test) and;


  • Go to a set bookmark in the Word Document ("table1")
  • Move to the start of the line with the bookmark
  • Move up to the previous line
  • Create a table with 1 row and 3 columns.
  • Inserts the values from the first and second textboxes and combobox into columns 1,2 and 3 respectively
  • Return to the specified "table2" bookmark and repeat this for each iterated line of the dynamically created controls


Also the Macro should


  • Go to a set bookmark in the Word Document ("table2")
  • Move to the start of the line with the bookmark
  • Move up to the previous line
  • Create a table with 1 row and 2 columns.
  • Inserts the values from the first and third textbox into columns 1 and 2 respectively
  • Return to the specified "table2" bookmark and repeat this for each iterated line of the dynamically created controls

So basically at each bookmark if there are 3 lines of dynamic controls after the macro runs there should be

A table with 3 rows and 3 columns located above bookmark "table1" containing the values from the first and second textbox and the combobox value.
A table with 3 rows and 2 columns located above bookmark "table2" containing the values from the first and third textbox values.

So my problem is that when the macro is run it either creates one line of the table at the top of the document, another at the "table1" bookmark and one at the "table2" bookmark or the 3 column table is created then another 3 column table is created inside the first cell of the first table and so on.

I am convinced I am missing something in regards to cursor control (as the usual problem is the first table cell is created at the first line of the document then the cursor seems to move to the "table1" bookmark and the macro continues from there).

If someone could give me some pointers on this I would greatly appreciated as I feel I am almost there but that I'm just overlooking something.

Here is the code I have so far, apologies in advance for any unused variables this is back of a napkin coding.

Code:
Private Sub CommandButton14_Click() 'Create WO Letter
'Open WO letter and copy paste data
    
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
   
    Dim riskCombo As Control
    Dim theTextBox802 As Control
    Dim theTextBox803 As Control
    Dim theTextBox804 As Control
    Dim b As Integer
    Dim c As Integer


Dim intNoOfColumns


Dim wdDoc


Dim objRange1


Dim objRange2


Dim objTable1


Dim objTable2


    b = iRiskCount
    c = 1
    
    
    If Me.WOLetter1.Value = False And Me.WOLetter2.Value = False And Me.WOLetter3.Value = False And Me.WOLetter4.Value = False Then
        MsgBox "You Must Choose a Letter Type"
    Exit Sub
    
    End If
    
    If UserForm1.MultiPage1.Pages(2).Frame15.Controls("Risk" & c).Value = "Risk" Then
         MsgBox "Select Risk Level for line " & c
    Exit Sub
    
    End If
    
        If Me.WOLetter1.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                objWord.Activate
                Set wdDoc = objWord.Documents.Add(ActiveWorkbook.Path & "\WOTest.docx")


            
        ElseIf Me.WOLetter2.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                'objWord.Documents.Open ActiveWorkbook.Path & "\WOTest.docx", ReadOnly:=True '"\test.dotx", ReadOnly:=True'"\Doc.dotm", ReadOnly:=True '"\test.dotx", ReadOnly:=True
                objWord.Activate
            
        ElseIf Me.WOLetter3.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                'objWord.Documents.Open ActiveWorkbook.Path & "\WOTest.docx", ReadOnly:=True '"\test.dotx", ReadOnly:=True'"\Doc.dotm", ReadOnly:=True '"\test.dotx", ReadOnly:=True
                objWord.Activate
            
        ElseIf Me.WOLetter4.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                'objWord.Documents.Open ActiveWorkbook.Path & "\WOTest.docx", ReadOnly:=True '"\test.dotx", ReadOnly:=True'"\Doc.dotm", ReadOnly:=True '"\test.dotx", ReadOnly:=True
                objWord.Activate


        End If
        




        For Each riskCombo In UserForm1.MultiPage1.Pages(2).Frame15.Controls


            If b > 0 Then


               Set objRange1 = objWord.Selection.Range
            Set objRange2 = objWord.Selection.Range


    'Table1
            objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table1"
            objWord.Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            objWord.Selection.MoveUp     
        
            wdDoc.Tables.Add objRange1, 1, 3
                objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table1"
                objWord.Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            objWord.Selection.MoveUp
            Set objTable1 = wdDoc.Tables(1)


    'Table 2


            objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table2"
            objWord.Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            objWord.Selection.MoveUp


            wdDoc.Tables.Add objRange2, 1, 2
                objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table2"
                objWord.Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            objWord.Selection.MoveUp
            Set objTable2 = wdDoc.Tables(1)
    
            With objTable1
                .Cell(0, 1).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text5" & c).Value
                .Cell(0, 2).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text6" & c).Value
                .Cell(0, 3).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Risk" & c).Value
            End With


            With objTable2
                .Cell(0, 1).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text5" & c).Value
                .Cell(0, 2).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text7" & c).Value
            End With
            
                    
                    c = c + 1
                    b = b - 1
           
        End If
    
    Next riskCombo


            objTable1.Columns(1).SetWidth ColumnWidth:=30, RulerStyle:= _
            wdAdjustNone


            objTable1.Columns(2).SetWidth ColumnWidth:=350, RulerStyle:= _
            wdAdjustNone


            objTable1.Columns(3).SetWidth ColumnWidth:=75, RulerStyle:= _
            wdAdjustNone


            objTable2.Columns(1).SetWidth ColumnWidth:=30, RulerStyle:= _
            wdAdjustNone


            objTable2.Columns(2).SetWidth ColumnWidth:=425, RulerStyle:= _
            wdAdjustNone




End Sub 'end of test

Even some reassurance that i am on the right track with this would be appreciated as I have been beating my head against this for the past week.
Thanks in advance,
K
 
Last edited:

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Is there a reason you cannot set another bookmark for this operation rather than tryng to move from the initial one?
 
Upvote 0
Dryver,
I'm using the bookmark to go to the specific place in the document then move left and up so that the bookmark is not deleted when the table is created.
I suppose I am using the bookmark as a makeshift cursor as when one row is created the bookmark still exists below the created table and the next row can then be inserted below the first and so on.
Does that make any sense?
K
 
Last edited:
Upvote 0
Ok so I managed to get something working but I'm hitting another error when the tables cross to another page. it throws up an error

"Run-time error '5992': Cannot access individual columns in this collection because the table has mixed cell widths."

Does anyone have any experience with this error?

Here's the code I'm using now for both tables;

Code:
Sub CommandButton14_Click() 'Create WO Letter
'Open WO letter and copy paste data
    
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Dim objTbl As Word.Table
    
    Dim objRow As Object
    Dim a As Integer
    
    'iRiskCount = iRiskCount + 1
    Dim riskCombo As Control
    Dim theTextBox802 As Control
    Dim theTextBox803 As Control
    Dim theTextBox804 As Control
    Dim b As Integer
    Dim c As Integer
    Dim f As Integer
    Dim g As Integer
    Dim Txt4 As String
    Dim Txt5 As String
    Dim Txt6 As String
    Dim Txt7 As String
    Dim Txt4Rplce As String
    Dim Txt5Rplce As String
    Dim Txt6Rplce As String
    Dim Txt7Rplce As String
    'Dim objRange As Range
    Dim intNoOfRows


Dim intNoOfColumns


'Dim objWord


Dim wdDoc As Document


Dim objRange1 As Word.Range


Dim objRange2 As Word.Range


Dim objTable1 As Word.Table


Dim objTable2 As Word.Table


Dim t As Table
'Dim c As Integer


    b = iRiskCount
    c = 1
    
    f = iRiskCount
    g = 1
    
    
    If Me.WOLetter1.Value = False And Me.WOLetter2.Value = False And Me.WOLetter3.Value = False And Me.WOLetter4.Value = False Then
        MsgBox "You Must Choose a Letter Type"
    Exit Sub
    
    End If
    
    If UserForm1.MultiPage1.Pages(2).Frame15.Controls("Risk" & c).Value = "Risk" Then
         MsgBox "Select Risk Level for line " & y + 1
    Exit Sub
    
    End If
    
        If Me.WOLetter1.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                'objWord.Documents.Open ActiveWorkbook.Path & "\WOTest.docx", ReadOnly:=True '"\test.dotx", ReadOnly:=True'"\Doc.dotm", ReadOnly:=True '"\test.dotx", ReadOnly:=True
                objWord.Activate
                Set wdDoc = objWord.Documents.Add(ActiveWorkbook.Path & "\WOTest4.docx")


        End If
        
                    Txt4 = Me.addressLine1.Text


                    Txt4Rplce = Replace(Txt4, vbLf, "")




                objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table1"
                
        For Each riskCombo In UserForm1.MultiPage1.Pages(2).Frame15.Controls


            If b > 0 Then
            
                    Txt4 = Me.addressLine1.Text
        
                    Txt5 = Me("Text5" & c).Text


                    Txt6 = Me("Text6" & c).Text
                    
                    Txt7 = Me("Text7" & c).Text


                    Txt4Rplce = Replace(Txt4, vbLf, "")


                    Txt5Rplce = Replace(Txt5, vbLf, "")


                    Txt6Rplce = Replace(Txt6, vbLf, "")
                    
                    Txt7Rplce = Replace(Txt7, vbLf, "")
           


        Set objRange1 = wdDoc.Bookmarks("table1").Range 'objWord.Selection.Range 'objWord.Selection.Range 'GoTo(What:=wdGoToBookmark, Name:="table1")


        objWord.Selection.EndKey Unit:=wdLine, Extend:=wdMove


    Set objTable1 = wdDoc.Tables.Add(Range:=objWord.Selection.Range, NumRows:=1, NumColumns:=3)
            objTable1.Rows(1).AllowBreakAcrossPages = True
            objWord.Selection.Tables(1).Rows.AllowBreakAcrossPages = True
        
        With objTable1


       
            .Columns(1).SetWidth ColumnWidth:=30, RulerStyle:=wdAdjustNone


            .Columns(2).SetWidth ColumnWidth:=340, RulerStyle:=wdAdjustNone


            .Columns(3).SetWidth ColumnWidth:=60, RulerStyle:=wdAdjustNone
            
            .Cell(0, 1).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text5" & c).Value & "."


            .Cell(0, 2).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text6" & c).Value


            .Cell(0, 3).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Risk" & c).Value


        End With


        objTable1.Rows(1).Range.Font.Name = "Arial"
        
        objTable1.Rows(1).Range.Font.Size = 11
        
        objTable1.Rows(1).Range.Font.Bold = True


        objWord.Selection.EndKey Unit:=wdLine, Extend:=wdMove


        objWord.Selection.MoveDown
        
        objWord.Selection.MoveDown
        
        objWord.Selection.InsertAfter vbCrLf 'vbLf 'vbCr
        


    End If
    
                    c = c + 1
                    b = b - 1
    
    Next riskCombo


objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table2"
                
        For Each riskCombo In UserForm1.MultiPage1.Pages(2).Frame15.Controls


            If f > 0 Then
                 
                    Txt5 = Me("Text5" & g).Text
                   
                    Txt7 = Me("Text7" & g).Text


                    Txt5Rplce = Replace(Txt5, vbLf, "")
                    
                    Txt7Rplce = Replace(Txt7, vbLf, "")
                     
        Set objRange2 = wdDoc.Bookmarks("table2").Range 'objWord.Selection.Range 'objWord.Selection.Range 'GoTo(What:=wdGoToBookmark, Name:="table2")


    Set objTable2 = wdDoc.Tables.Add(Range:=objWord.Selection.Range, NumRows:=1, NumColumns:=2)
            objTable2.Rows(1).AllowBreakAcrossPages = True
            objWord.Selection.Tables(1).Rows.AllowBreakAcrossPages = True
    
            objWord.Selection.EndKey Unit:=wdLine, Extend:=wdMove


            objWord.Selection.MoveDown
            objWord.Selection.MoveDown
            
            objWord.Selection.InsertAfter vbCrLf 'vbLf 'vbCr


            With objTable2
            
            .Columns(1).SetWidth ColumnWidth:=30, RulerStyle:=wdAdjustNone


            .Columns(2).SetWidth ColumnWidth:=400, RulerStyle:=wdAdjustNone
            
            .Cell(0, 1).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text5" & g).Value & "."


            .Cell(0, 2).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text7" & g).Value




        End With


        objTable2.Rows(1).Range.Font.Name = "Arial"
        
        objTable2.Rows(1).Range.Font.Size = 11
        
        objTable2.Rows(1).Range.Font.Bold = True
        
        objWord.Selection.EndKey Unit:=wdLine, Extend:=wdMove
        
        objWord.Selection.MoveDown
        
        objWord.Selection.MoveDown
        
        objWord.Selection.MoveDown
        
        objWord.Selection.InsertAfter vbCrLf 'vbLf 'vbCr




    End If


                    g = g + 1
                    f = f - 1
    
    Next riskCombo




End Sub 'end of test
 
Upvote 0
Ok so I managed to get something working but I'm hitting another error when the tables cross to another page. it throws up an error

"Run-time error '5992': Cannot access individual columns in this collection because the table has mixed cell widths."

Does anyone have any experience with this error?

Here's the code I'm using now for both tables;

Code:
Sub CommandButton14_Click() 'Create WO Letter
'Open WO letter and copy paste data
    
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Dim objTbl As Word.Table
    
    Dim objRow As Object
    Dim a As Integer
    
    'iRiskCount = iRiskCount + 1
    Dim riskCombo As Control
    Dim theTextBox802 As Control
    Dim theTextBox803 As Control
    Dim theTextBox804 As Control
    Dim b As Integer
    Dim c As Integer
    Dim f As Integer
    Dim g As Integer
    Dim Txt4 As String
    Dim Txt5 As String
    Dim Txt6 As String
    Dim Txt7 As String
    Dim Txt4Rplce As String
    Dim Txt5Rplce As String
    Dim Txt6Rplce As String
    Dim Txt7Rplce As String
    'Dim objRange As Range
    Dim intNoOfRows


Dim intNoOfColumns


'Dim objWord


Dim wdDoc As Document


Dim objRange1 As Word.Range


Dim objRange2 As Word.Range


Dim objTable1 As Word.Table


Dim objTable2 As Word.Table


Dim t As Table
'Dim c As Integer


    b = iRiskCount
    c = 1
    
    f = iRiskCount
    g = 1
    
    
    If Me.WOLetter1.Value = False And Me.WOLetter2.Value = False And Me.WOLetter3.Value = False And Me.WOLetter4.Value = False Then
        MsgBox "You Must Choose a Letter Type"
    Exit Sub
    
    End If
    
    If UserForm1.MultiPage1.Pages(2).Frame15.Controls("Risk" & c).Value = "Risk" Then
         MsgBox "Select Risk Level for line " & y + 1
    Exit Sub
    
    End If
    
        If Me.WOLetter1.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                'objWord.Documents.Open ActiveWorkbook.Path & "\WOTest.docx", ReadOnly:=True '"\test.dotx", ReadOnly:=True'"\Doc.dotm", ReadOnly:=True '"\test.dotx", ReadOnly:=True
                objWord.Activate
                Set wdDoc = objWord.Documents.Add(ActiveWorkbook.Path & "\WOTest4.docx")


        End If
        
                    Txt4 = Me.addressLine1.Text


                    Txt4Rplce = Replace(Txt4, vbLf, "")




                objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table1"
                
        For Each riskCombo In UserForm1.MultiPage1.Pages(2).Frame15.Controls


            If b > 0 Then
            
                    Txt4 = Me.addressLine1.Text
        
                    Txt5 = Me("Text5" & c).Text


                    Txt6 = Me("Text6" & c).Text
                    
                    Txt7 = Me("Text7" & c).Text


                    Txt4Rplce = Replace(Txt4, vbLf, "")


                    Txt5Rplce = Replace(Txt5, vbLf, "")


                    Txt6Rplce = Replace(Txt6, vbLf, "")
                    
                    Txt7Rplce = Replace(Txt7, vbLf, "")
           


        Set objRange1 = wdDoc.Bookmarks("table1").Range 'objWord.Selection.Range 'objWord.Selection.Range 'GoTo(What:=wdGoToBookmark, Name:="table1")


        objWord.Selection.EndKey Unit:=wdLine, Extend:=wdMove


    Set objTable1 = wdDoc.Tables.Add(Range:=objWord.Selection.Range, NumRows:=1, NumColumns:=3)
            objTable1.Rows(1).AllowBreakAcrossPages = True
            objWord.Selection.Tables(1).Rows.AllowBreakAcrossPages = True
        
        With objTable1


       
            .Columns(1).SetWidth ColumnWidth:=30, RulerStyle:=wdAdjustNone


            .Columns(2).SetWidth ColumnWidth:=340, RulerStyle:=wdAdjustNone


            .Columns(3).SetWidth ColumnWidth:=60, RulerStyle:=wdAdjustNone
            
            .Cell(0, 1).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text5" & c).Value & "."


            .Cell(0, 2).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text6" & c).Value


            .Cell(0, 3).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Risk" & c).Value


        End With


        objTable1.Rows(1).Range.Font.Name = "Arial"
        
        objTable1.Rows(1).Range.Font.Size = 11
        
        objTable1.Rows(1).Range.Font.Bold = True


        objWord.Selection.EndKey Unit:=wdLine, Extend:=wdMove


        objWord.Selection.MoveDown
        
        objWord.Selection.MoveDown
        
        objWord.Selection.InsertAfter vbCrLf 'vbLf 'vbCr
        


    End If
    
                    c = c + 1
                    b = b - 1
    
    Next riskCombo


objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table2"
                
        For Each riskCombo In UserForm1.MultiPage1.Pages(2).Frame15.Controls


            If f > 0 Then
                 
                    Txt5 = Me("Text5" & g).Text
                   
                    Txt7 = Me("Text7" & g).Text


                    Txt5Rplce = Replace(Txt5, vbLf, "")
                    
                    Txt7Rplce = Replace(Txt7, vbLf, "")
                     
        Set objRange2 = wdDoc.Bookmarks("table2").Range 'objWord.Selection.Range 'objWord.Selection.Range 'GoTo(What:=wdGoToBookmark, Name:="table2")


    Set objTable2 = wdDoc.Tables.Add(Range:=objWord.Selection.Range, NumRows:=1, NumColumns:=2)
            objTable2.Rows(1).AllowBreakAcrossPages = True
            objWord.Selection.Tables(1).Rows.AllowBreakAcrossPages = True
    
            objWord.Selection.EndKey Unit:=wdLine, Extend:=wdMove


            objWord.Selection.MoveDown
            objWord.Selection.MoveDown
            
            objWord.Selection.InsertAfter vbCrLf 'vbLf 'vbCr


            With objTable2
            
            .Columns(1).SetWidth ColumnWidth:=30, RulerStyle:=wdAdjustNone


            .Columns(2).SetWidth ColumnWidth:=400, RulerStyle:=wdAdjustNone
            
            .Cell(0, 1).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text5" & g).Value & "."


            .Cell(0, 2).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text7" & g).Value




        End With


        objTable2.Rows(1).Range.Font.Name = "Arial"
        
        objTable2.Rows(1).Range.Font.Size = 11
        
        objTable2.Rows(1).Range.Font.Bold = True
        
        objWord.Selection.EndKey Unit:=wdLine, Extend:=wdMove
        
        objWord.Selection.MoveDown
        
        objWord.Selection.MoveDown
        
        objWord.Selection.MoveDown
        
        objWord.Selection.InsertAfter vbCrLf 'vbLf 'vbCr




    End If


                    g = g + 1
                    f = f - 1
    
    Next riskCombo




End Sub 'end of test


Hi, Keaden

Is the error 5992 happens in Line: (objTable1.Rows(1).AllowBreakAcrossPages = True )
Or somewhere like .columns(1,2)...
This maybe caused by mergecells in your Word Table, because the mergecells exist, VBA cannot set width to it.
I've been encountered such an error before.
Maybe you have to locate your table's mergecells first,and then to set width of the table.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top