Question : Creating Word Tables with Excel VBA

I am trying to write some Excel VBA code to create and instance of Word, add a document and insert a table at the insertion point.
Everything is fine until I try to create the table at which point I get a Runtime Error 450.

The code I am using is

Sub CreateWordTable()
    Dim objWord As Object
   
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    objWord.documents.Add
    objWord.Activedocument.tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:=3, DefaultTableBehavior:=1, AutoFitBehavior:=0
End Sub

The problem seems to be in the final code line before End Sub.  This has been copied from a recorded Word macro with the last two arguements changed to their constants as obtained by entering ?wdWord9TableBehavior and ?wdAutoFitFixed into the immediate window.

Any help would be much appreciated as this is holding up a few different projects

Thanks - Kevinovitch

Answer : Creating Word Tables with Excel VBA

To fill it in add this after the table add listed in my previous comment:

    For Each it In Selection.Cells
        objWord.Selection.TypeText CStr(it.Value)
        objWord.Selection.MoveRight wdCell
    Next it

This takes the Excel selection and cycles through it and adds the values (as strings -- that's what the CStr is for) to the table just created.  if you wanted to make it for any size table, change the following in the first statement I gave you

NumRows:=Selection.Rows.Count, NumColumns:=Selection.Columns.Count

So the entire code is now this (thought it easier to copy/paste what I had so you could see it in its entirety):

Sub CreateWordTable()
    Dim objWord As Object
    Dim it As Range
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    objWord.documents.Add
    objWord.ActiveDocument.Tables.Add Range:=objWord.Selection.Range, NumRows:=Selection.Rows.Count, NumColumns:=Selection.Columns.Count, DefaultTableBehavior:=1, AutoFitBehavior:=0
    For Each it In Selection.Cells
        objWord.Selection.TypeText CStr(it.Value)
        objWord.Selection.MoveRight wdCell
    Next it
End Sub


Scott
Random Solutions  
 
programming4us programming4us