Открыть документ в Ворде

Option Explicit
Sub WordTable01()
'by Fatty T.O.H. () 2007 * all rights removed
' make sure you set reference to Microsoft Word Object Library!
Dim wrd As Object
Dim wdoc As Object
Dim wtbl As Object
Dim rng As Object
Dim i As Integer
Dim j As Integer
Dim ed As Integer
Set wrd = CreateObject("Word.Application")
wrd.Documents.Add
Set wdoc = wrd.ActiveDocument
wrd.Visible = True
wrd.Activate
wrd.ScreenUpdating = False
    With wdoc
        .Activate
        .ActiveWindow.Visible = True
        .Select
        With .PageSetup
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(0.748)
        .BottomMargin = InchesToPoints(1.2)
        .RightMargin = InchesToPoints(0.54)
        End With
    End With
Set rng = wdoc.Range(Start:=0, End:=0)
        With rng.Paragraphs(1).Range
        .Font.Size = 9
        .Font.Bold = True
        .Font.Name = "Tahoma"
        .Font.color = wdColorBlue
        End With
rng.InsertBefore Text:="The Table Follows Here:" & vbCr & vbCr
Set rng = wdoc.Range
ed = rng.End - 1
Set wtbl = wdoc.Tables.Add(Range:=wdoc.Range(Start:=ed, End:=ed), NumRows:=20, NumColumns:=5)
For i = 1 To wtbl.Rows.Count
For j = 1 To wtbl.Columns.Count
wtbl.Cell(i, j).Range.ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphLeft
wtbl.Columns(j).Cells(i).Range.Text = "R: " & CStr(i) & " * C: " & CStr(j)
Next
Next
Set rng = Nothing
wrd.ScreenUpdating = True
wrd.Selection.Collapse
End Sub

Option Explicit
Sub AddTableToExistDoc()
'by Fatty T.O.H. () 2007 * all rights removed
' make sure you set reference to Microsoft Word Object Library!
Dim wrd As Object
Dim wdoc As Object
Dim wtbl As Object
Dim rng As Object
Dim i As Integer
Dim j As Integer
Dim ed As Integer
Dim fname As String
fname = ThisDrawing.Path & "\" & "Test.doc" '<--change the full path here
Set wrd = CreateObject("Word.Application")
wrd.Visible = True
wrd.Activate
Set wdoc = wrd.Documents.Open(fname)
wdoc.Activate
Set wdoc = wrd.ActiveDocument
wrd.ScreenUpdating = False
    With wdoc
        .Activate
        .ActiveWindow.Visible = True
        .Select
        With .PageSetup
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(0.748)
        .BottomMargin = InchesToPoints(1.2)
        .RightMargin = InchesToPoints(0.54)
        End With
    End With
Set rng = wdoc.Range(Start:=0, End:=0)
        With rng.Paragraphs(1).Range
        .Font.Size = 9
        .Font.Bold = True
        .Font.Name = "Tahoma"
        .Font.color = wdColorBlue
        End With
rng.InsertBefore Text:="The Table Follows Here:" & vbCr & vbCr
Set rng = wdoc.Range
ed = rng.End - 1
Set wtbl = wdoc.Tables.Add(Range:=wdoc.Range(Start:=ed, End:=ed), NumRows:=20, NumColumns:=5)
For i = 1 To wtbl.Rows.Count
For j = 1 To wtbl.Columns.Count
wtbl.Cell(i, j).Range.ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphLeft
wtbl.Columns(j).Cells(i).Range.Text = "R: " & CStr(i) & " * C: " & CStr(j)
Next
Next
Set rng = Nothing
wrd.ScreenUpdating = True
wrd.Selection.Collapse
wdoc.Save
wdoc.Close
wrd.Quit
Set wdoc = Nothing
Set wrd = Nothing
MsgBox "Done"
End Sub