Private Sub cmd_drucken_Click()
 
Dim WordAppl As Word.Application ' Word-Application
Dim WdDoc As Word.Document       ' Word-Dokument
Dim WordApplLiefNicht As Boolean ' Falls Word nicht läuft
Dim wdRng As Word.Range
Dim wdTable As Word.Table
Dim xi&
    ' 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
    Set WdDoc = WordAppl.Documents.Add( _
                    Template:=App.Path & "\" & WordDocVorlage, _
                    NewTemplate:=False _
                )
    On Error GoTo 0
    ' Word unsichtbar machen
    WordAppl.Application.Visible = True
'===================================================
Startdatum = "01." & lbl_monatszahl.Caption & "." & Me.cmb_jahr.Text
Enddatum = DateAdd("m", 1, Startdatum) - 1
Set wdRng = WdDoc.Range(WdDoc.Range.End - 1, WdDoc.Range.End) 'EndewdRng.Text = 
' vbCrLf  ' Noch einen Zeilenumbruch anfügen
Set wdRng = WdDoc.Range(WdDoc.Range.End - 1, WdDoc.Range.End)
Set wdTable = WdDoc.Tables.Add(wdRng, 1, 13) 'nun die Tabelle einfügen
'Linien
For xi = -6 To -1
 wdTable.Borders(xi).LineStyle = 1  'wdLineStyleSingle
 wdTable.Borders(xi).LineWidth = 4  'wdLineWidth050pt = 4
 wdTable.Rows.Alignment = wdAlignRowCenter
Next
wdTable.Borders(-7).LineStyle = 0
wdTable.Borders(-8).LineStyle = 0
wdTable.Borders.Shadow = False
'Kopfzeile
wdTable.Cell(wdTable.Rows.Count, 1).Range.Font.Size = 10
wdTable.Cell(1, 1).Range.Text = "Tag"
wdTable.Cell(wdTable.Rows.Count, 2).Range.Font.Size = 10
wdTable.Cell(1, 2).Range.Text = "Uhrzeit"
wdTable.Cell(wdTable.Rows.Count, 3).Range.Font.Size = 10
wdTable.Cell(1, 3).Range.Text = "Temperatur"
'Bis 13 ___________________________________________
'Datum
'For dteDatum = dteAbDatum To dteBisDatum
For AktuellesDatum = Startdatum To Enddatum
 wdTable.Rows.Add
 If Arbeitstag(AktuellesDatum) = 0 Then
   wdTable.Cell(wdTable.Rows.Count, 1).Range.Font.Size = 11
   wdTable.Cell(wdTable.Rows.Count, 1).Range.Text = Format(AktuellesDatum, "dd." & _
     "ddd")
 Else
  wdTable.Cell(wdTable.Rows.Count, 1).Range.Font.Size = 11
  wdTable.Cell(wdTable.Rows.Count, 1).Range.Text = Format(AktuellesDatum, "dd." & _
    "ddd")
 End If
 If Arbeitstag(AktuellesDatum) = 0 Then
  ' Datum Ist EIN Feiertag
  wdTable.Cell(wdTable.Rows.Count, 1).Range.Font.Size = 11
  wdTable.Cell(wdTable.Rows.Count, 1).Shading.Texture = 150 'wdTexture15Percent
  wdTable.Cell(wdTable.Rows.Count, 2).Shading.Texture = 150
  wdTable.Cell(wdTable.Rows.Count, 3).Shading.Texture = 150
'Bis 13______________________________________________
 Else
  wdTable.Cell(wdTable.Rows.Count, 1).Range.Font.Size = 11
  wdTable.Cell(wdTable.Rows.Count, 1).Shading.Texture = 0 'wdTextureNone
  wdTable.Cell(wdTable.Rows.Count, 2).Shading.Texture = 0
  wdTable.Cell(wdTable.Rows.Count, 3).Shading.Texture = 0
'Bis 13________________________________________________
 End If
Next
    On Error GoTo keinDrucker
    ' Dokument drucken und warten bis Druck seitens Word abgeschlossen
    Call WdDoc.PrintOut(Background:=False)
keinDrucker:
    If Err.Number = 5140 Then
    MsgBox " Kein Drucker gefunden. " & vbCrLf & " Bitte Drucker einschalten" & _
      "und dann erneut drucken.", vbCritical
    ' Dokument schließen / nicht speichern
    WdDoc.Close wdDoNotSaveChanges
    ' Dokument zerstören
    Set WdDoc = Nothing
    ' Word beenden, falls wir es erst gestartet haben
    If WordApplLiefNicht Then
        WordAppl.Application.Quit
    End If
    Set WordAppl = Nothing
    Exit Sub
    End If
    ' Dokument schließen / nicht speichern
    WdDoc.Close wdDoNotSaveChanges
    ' Dokument zerstören
    Set WdDoc = Nothing
ClearExit:
    ' Word beenden, falls wir es erst gestartet haben
    If WordApplLiefNicht Then
        WordAppl.Application.Quit
    End If
    Set WordAppl = Nothing
    Exit Sub
errorMsgWord:
    MsgBox "Es konnte keine Verbindung zu Word hergestellt werden!", 16, _
      "Fehler"
    Exit Sub
errorMsgVorlage:
    MsgBox "Die Dokumentvorlage '" & WordDocVorlage & "' konnte nicht geöffnet" & _
      "werden !", 16, "Fehler"
    GoTo ClearExit
End Sub