Create empty table (with headings) in Word document after some text

dwsteyl

New Member
Joined
Sep 28, 2017
Messages
20
Hi guys,

I hope this is the right forum for this question. I'm fairly competent in VBA in Excel, but recently started tinkering with creating letters in MS Word from our Excel VBA programmed management system. I work in Microsoft 365.

I'm creating a Word document from scratch (out of Excel), and start putting together the letter with some client info. After that I need to put in a table with three columns and ten rows. The first row should have text that act as headers - "Name", "ID nr" and "Signature". The columns should have about the spacing of letter size 18.

I've been playing around with code for a few days and have tried multiple searches on forums. For some reason I just cannot get it right. Here's part of my code for creating the Word file and getting the letter started:

VBA Code:
Dim wdApp As Word.Application
Dim objSelection

Set wdApp = New Word.Application

With wdApp
    .visible = True
    .Activate
    .Documents.Add
    .Selection.WholeStory  'select all informaiton
    .Selection.Style = ("No Spacing")  'change style

Set objSelection = wdApp.Selection

Dim ClientLongName As String

ClientLongName = UCase(txtRegSurname.Text)

objSelection.ParagraphFormat.Alignment = wdAlignParagraphCenter
objSelection.Font.Underline = wdUnderlineSingle
objSelection.Font.Bold = True
objSelection.Font.Size = 18
objSelection.TypeText ClientLongName
objSelection.TypeParagraph
objSelection.TypeParagraph

objSelection.ParagraphFormat.Alignment = wdAlignParagraphCenter
objSelection.Font.Underline = wdUnderlineNone
objSelection.Font.Bold = True
objSelection.Font.Size = 12
objSelection.TypeText "RE: MANDATE FOR UPLOADING BENEFICIAL OWNERSHIP WITH THE COMPANIES AND INTELLECTUAL PROPERTY COMMISSION (CIPC)"
objSelection.TypeParagraph
objSelection.TypeParagraph

objSelection.ParagraphFormat.Alignment = wdAlignParagraphJustify
objSelection.Font.Underline = wdUnderlineSingle
objSelection.Font.Bold = False
objSelection.TypeText "Introduction: "
objSelection.TypeParagraph
objSelection.TypeText "Beneficial Ownership: Preparation and lodgement of documents to CIPC."
objSelection.TypeParagraph

'I need to enter a table here with 3 columns and 10 rows. The first row should act as headers with the headings "Name", "ID nr" and "Signature"

End With

Any assistance with inserting the table correctly will be greatly appreciated.

Regards
dwsteyl
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
An alternative suggestion: Wouldn't it be easier to get all the formatting, headers, etc.. in Excel and then copy and paste it into the Word Doc?
 
Upvote 0
An alternative suggestion: Wouldn't it be easier to get all the formatting, headers, etc.. in Excel and then copy and paste it into the Word Doc?
Hi, thank you for the suggestion. I use a mysql server together with a form to retrieve data of the entity in question, and then use that data to compile the letter. I could go the way of creating the table in Excel and just copying it in from a hidden sheet since it is always going to be the same. If I could do it via code though it should be so much cleaner.
 
Upvote 0
This is a general code that connects to mySQL and write to Excel in cell A2.

VBA Code:
Sub QueryMySQL()
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim strConn As String
    Dim i As Integer
   
    strConn = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=your_server_address;DATABASE=your_database_name;UID=your_username;PWD=your_password;"
   
    strSQL = "SELECT * FROM your_table;"
   
    Set conn = CreateObject("ADODB.Connection")
   
    conn.Open strConn
   
    Set rs = CreateObject("ADODB.Recordset")
   
    rs.Open strSQL, conn
   
    i = 2 ' Start writing from cell A2
   
    Do While Not rs.EOF
        Cells(i, 1).Value = rs.Fields(0).Value ' Write data to cell A2 and downwards
        rs.MoveNext
        i = i + 1
    Loop
   
    rs.Close
    conn.Close
   
    Set rs = Nothing
    Set conn = Nothing
End Sub
 
Upvote 0
This is a general code that connects to mySQL and write to Excel in cell A2.

VBA Code:
Sub QueryMySQL()
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim strConn As String
    Dim i As Integer
  
    strConn = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=your_server_address;DATABASE=your_database_name;UID=your_username;PWD=your_password;"
  
    strSQL = "SELECT * FROM your_table;"
  
    Set conn = CreateObject("ADODB.Connection")
  
    conn.Open strConn
  
    Set rs = CreateObject("ADODB.Recordset")
  
    rs.Open strSQL, conn
  
    i = 2 ' Start writing from cell A2
  
    Do While Not rs.EOF
        Cells(i, 1).Value = rs.Fields(0).Value ' Write data to cell A2 and downwards
        rs.MoveNext
        i = i + 1
    Loop
  
    rs.Close
    conn.Close
  
    Set rs = Nothing
    Set conn = Nothing
End Sub
Thank you for your message. I found this below, and will test it to see if it works.

VBA Code:
Sub CreateWordTable()
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim wordTable As Object
    Dim i As Integer
    
    ' Create a new instance of Word application
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True ' Make Word visible (optional)
    
    ' Create a new Word document
    Set wordDoc = wordApp.Documents.Add
    
    ' Add a table with 3 columns and 10 rows
    Set wordTable = wordDoc.Tables.Add(wordDoc.Range, 10, 3)
    
    ' Add text to the first row
    wordTable.Cell(1, 1).Range.Text = "Name"
    wordTable.Cell(1, 2).Range.Text = "IDNR"
    wordTable.Cell(1, 3).Range.Text = "Signature"
    
    ' Fill the rest of the table with example data
    For i = 2 To 10
        wordTable.Cell(i, 1).Range.Text = "Name" & i
        wordTable.Cell(i, 2).Range.Text = "IDNR" & i
        wordTable.Cell(i, 3).Range.Text = "Signature" & i
    Next i
    
    ' Clean up
    Set wordTable = Nothing
    Set wordDoc = Nothing
    Set wordApp = Nothing
End Sub
 
Upvote 0
This is a general code that connects to mySQL and write to Excel in cell A2.

VBA Code:
Sub QueryMySQL()
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim strConn As String
    Dim i As Integer
  
    strConn = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=your_server_address;DATABASE=your_database_name;UID=your_username;PWD=your_password;"
  
    strSQL = "SELECT * FROM your_table;"
  
    Set conn = CreateObject("ADODB.Connection")
  
    conn.Open strConn
  
    Set rs = CreateObject("ADODB.Recordset")
  
    rs.Open strSQL, conn
  
    i = 2 ' Start writing from cell A2
  
    Do While Not rs.EOF
        Cells(i, 1).Value = rs.Fields(0).Value ' Write data to cell A2 and downwards
        rs.MoveNext
        i = i + 1
    Loop
  
    rs.Close
    conn.Close
  
    Set rs = Nothing
    Set conn = Nothing
End Sub
I played around with my proposed code, and found the solution. See the extracted code below. Bit slow because it creates diagonals in the table cells, which has to be removed afterwards, but at least it does exactly what I wanted.

VBA Code:
' Add a table with 3 columns and 10 rows
Set wordTable = objSelection.Tables.Add(objSelection.Range, 10, 3)

' Add text to the first row
'objSelection.Font.Size = 11
wordTable.cell(1, 1).Range.Font.Size = 11
wordTable.cell(1, 1).Range.Text = "Name"
'objSelection.Font.Size = 11
wordTable.cell(1, 2).Range.Font.Size = 11
wordTable.cell(1, 2).Range.Text = "IDNR"
'objSelection.Font.Size = 11
wordTable.cell(1, 3).Range.Font.Size = 11
wordTable.cell(1, 3).Range.Text = "Signature"

' Loop through each cell in the table
For Each cell In wordTable.Range.Cells
    ' Loop through each border of the cell and set the line style to single
    For Each border In cell.Borders
        border.LineStyle = wdLineStyleSingle
    Next border
Next cell

'Remove diagonals
wordTable.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
wordTable.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone

' Clean up
Set wordTable = Nothing

Thank you for your input.

Regards
dwsteyl
 
Upvote 0

Forum statistics

Threads
1,216,500
Messages
6,131,016
Members
449,615
Latest member
Nic0la

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