Worddatei - Tabelle - Zeilen hinzufügen

Frage: In einer Worddatei ist eine Tabelle. In dieser Tabelle möchte ich am Ende bzw. zwischendrin Zeilen einfügen - das Ganze aus Excel. Wie geht das?

Option Explicit
Public Sub Main()
    Dim objTable As Object
    Dim objWDApp As Object
    Dim objWDDoc As Object
    Dim objRow As Object
    On Error GoTo Fin
    Set objWDApp = OffApp("Word")
    If Not objWDApp Is Nothing Then
        Set objWDDoc = objWDApp.Documents.Open _
            (ThisWorkbook.Path & Application.PathSeparator & "Doc1.doc")
        Set objTable = objWDDoc.Tables(1)
        With objTable
            Debug.Print .Rows.Count
            .Rows.Add ' Am Ende Zeile einfuegen
            Set objRow = .Rows.Add(BeforeRow:=.Rows(3))
            Debug.Print .Rows.Count
        End With
    End If
Fin:
    Set objRow = Nothing
    Set objTable = Nothing
    Set objWDDoc = Nothing
    Set objWDApp = Nothing
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String) As Object
    Dim objApp As Object
    On Error Resume Next
    Set objApp = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objApp = CreateObject(strApp & ".Application")
            objApp.Visible = True
            If Err.Number > 0 Then
                MsgBox Err.Number & " " & Err.Description
                Set objApp = Nothing
            End If
        Case 0
        Case Else
            MsgBox Err.Number & " " & Err.Description
            Set objApp = Nothing
    End Select
    On Error GoTo 0
    Set OffApp = objApp
    Set objApp = Nothing
End Function

Hier noch ein Beispiel mit Worddatei: Sample

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...