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

[dwsteyl]

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:

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

 

[Cubist]

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?

 

[dwsteyl]

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.

 

[Cubist]

This is a general code that connects to mySQL and write to Excel in cell A2.

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

 

[dwsteyl]

This is a general code that connects to mySQL and write to Excel in cell A2.

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.

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

 

[dwsteyl]

This is a general code that connects to mySQL and write to Excel in cell A2.

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.

' 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