Dim n As Long
    Dim WordAppl As Word.Application
    Dim oRange As Word.Range
    Dim WdDoc As Word.Document
    Dim WordApplLiefNicht As Boolean
 
    On Error Resume Next
    Set WordAppl = GetObject(, "Word.Application")
 
    ' Wenn Word nicht ausgeführt wird, Word starten:
    On Error GoTo errorMsgWord
    If WordAppl Is Nothing Then
        WordApplLiefNicht = True
        Set WordAppl = CreateObject("Word.Application")
    End If
 
    ' Dokument öffnen
    On Error GoTo errorMsgVorlage
    WordAppl.Documents.Add _
                    Template:=App.Path & "\" & WordDocVorlage, _
                    NewTemplate:=False
    On Error GoTo 0
 
    Set oRange = WordAppl.ActiveDocument.Sections(1).Range
 
    WordAppl.Selection.MoveRight unit:=wdCell
    WordAppl.Selection.MoveRight unit:=wdCell
    WordAppl.Selection.MoveRight unit:=wdCell
    WordAppl.Selection.MoveRight unit:=wdCell
    WordAppl.Selection.MoveRight unit:=wdCell
    WordAppl.Selection.MoveRight unit:=wdCell
    WordAppl.Selection.MoveRight unit:=wdCell
 
    sSql = "SELECT * FROM tblPositionen WHERE rid=" & rId
    If dbQuery = "ok" Then
        With oRs
            If .RecordCount > 0 Then
                'WordAppl.ActiveDocument.Tables.Add Range:=oRange, 
                ' NumRows:=.RecordCount, NumColumns:=7, _
                'DefaultTableBehavior:=wdWord9TableBehavior, 
                ' AutoFitBehavior:=wdAutoFitFixed
 
                With WordAppl.Selection.Tables(1)
                    .ApplyStyleHeadingRows = True
                    .ApplyStyleLastRow = True
                    .ApplyStyleFirstColumn = True
                    .ApplyStyleLastColumn = True
                End With
 
                n = 1
                Do While Not .EOF
                    'LFD
                    WordAppl.Selection.TypeText n & "."
                    WordAppl.Selection.MoveRight unit:=wdCell
                    'Datum
                    WordAppl.Selection.TypeText .Fields("datum").Value
                    WordAppl.Selection.MoveRight unit:=wdCell
                    'Leistung
                    WordAppl.Selection.TypeText Replace(.Fields( _
                      "leistung").Value, "'", "'")
                    WordAppl.Selection.MoveRight unit:=wdCell
                    'Stundensatz
                    WordAppl.Selection.TypeText cfgPreis(CLng(.Fields( _
                      "satz").Value))
                    WordAppl.Selection.MoveRight unit:=wdCell
                    'Stunden
                    WordAppl.Selection.TypeText CDbl(CLng(.Fields( _
                      "stunden").Value) / 100)
                    WordAppl.Selection.MoveRight unit:=wdCell
                    'MwSt
                    WordAppl.Selection.TypeText CDbl(CLng(.Fields( _
                      "mwst").Value) / 100)
                    WordAppl.Selection.MoveRight unit:=wdCell
                    'Betrag
                    WordAppl.Selection.TypeText cfgPreis(CLng(.Fields( _
                      "betrag").Value))
                    If n < .RecordCount Then WordAppl.Selection.MoveRight _
                    unit:=wdCell
                    n = n + 1
                    .MoveNext
                Loop
 
                WordAppl.Visible = True
                Set WordAppl = Nothing
                Set oRange = Nothing
            End If
            .Close
        End With
        Set oRs = Nothing
    Else
        MsgBox dbQuery, vbCritical, App.Title
    End If
    Call CloseConn
 
    Screen.MousePointer = 0