Private Sub cmd_word_Click()
Dim sql As String
Dim word As word.Application
 
 
      If word Is Nothing Then
        Set word = CreateObject("Word.Application")    ' Word starten
      Else
        Set word = GetObject(, "Word.Application") ' Word verwenden, falls 
        ' bereits gestartet
      End If
      If word Is Nothing Then
        MsgBox "...konnte keine Verbindung zu Word herstellen!", 16, _
          "Problem..."
        Exit Sub
      End If
      On Error GoTo 0
      word.Documents.Add
      If word.ActiveWindow.View.SplitSpecial <> wdPaneNone Then _
        word.ActiveWindow.Panes(2).Close
      If word.ActiveWindow.ActivePane.View.Type = wdNormalView Or _
         word.ActiveWindow.ActivePane.View.Type = wdOutlineView Or _
         word.ActiveWindow.ActivePane.View.Type = wdMasterView Then _
         word.ActiveWindow.ActivePane.View.Type = wdPageView
 
      Set Db = OpenDatabase(pfad_zur_datenbank)
      With Db
        For Each QueryDef In .QueryDefs
          If UCase$(Left$(QueryDef.Name, 4)) <> "MSYS" Then
            If cmb_abfragen.text = QueryDef.Name Then
              sql_anweisung = QueryDef.sql
            End If
          End If
        Next
      End With
      Db.Close
      Set Db = Nothing
 
      With recSQL
        If .State = adStateOpen Then .Close
        .Open sql_anweisung, conn, adOpenStatic, adLockOptimistic
        recSQL.MoveFirst
      End With
 
    ActiveDocument.Tables.Add Range:=Selection.Range, _
      NumRows:=recSQL.RecordCount, NumColumns:= _
        recSQL.Fields.Count - 1, DefaultTableBehavior:=wdWord9TableBehavior, _
        AutoFitBehavior:= _
        wdAutoFitFixed
 
    With word.Selection.Tables(1)
        If .Style <> "Tabellengitternetz" Then
            .Style = "Tabellengitternetz"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = True
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = True
    End With
 
      For i = 0 To recSQL.RecordCount - 1
        For z = 1 To recSQL.Fields.Count - 1
          If recSQL.Fields.Item(z) <> "" Then
            word.Selection.TypeText recSQL.Fields.Item(z)
            word.Selection.MoveRight Unit:=wdCell
          Else
            If i = recSQL.RecordCount - 1 And z = recSQL.Fields.Count - 1 Then
            Else
              word.Selection.MoveRight Unit:=wdCell
            End If
          End If
        Next z
        recSQL.MoveNext
      Next i
    word.Visible = True
End Sub

cu puppet

Wer ?berall seinen Senf dazu gibt, kommt schnell in den Verdacht ein W?rstchen zu sein!