Option Explicit
Sub druck()
Dim intRow As Integer, intLastRow As Integer
Dim al As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim V1, V2, V3, V4
Dim appWord As Object
Dim docTest As Object
Dim txt As String
txt = "Uhr"
With ThisWorkbook
Set al = .Worksheets("Auslieferungsliste")
End With
lngZeilen = al.Cells(al.Rows.Count, 1).End(xlUp).Row
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
For y = 2 To lngZeilen
With al
V1 = .Cells(y, 2).Value
V2 = .Cells(y, 3).Value
V3 = .Cells(y, 4).Value
V4 = .Cells(y, 5).Text
End With
If V1 <> "" And V2 <> "" And V3 <> "" And V4 <> "" Then
Set docTest = appWord.documents.Add("C:\Dokumente und Einstellungen\P325130\Desktop\kennzeichen.doc")
docTest.Activate
docTest.Bookmarks("kennzeichen").Range.Text = V1
docTest.Bookmarks("name").Range.Text = V2
docTest.Bookmarks("datum").Range.Text = V3
docTest.Bookmarks("uhrzeit").Range.Text = V4 & " " & txt
DoEvents
docTest.PrintOut
docTest.Close SaveChanges:=False
Else
End If
Next y
Application.DisplayAlerts = False
If appWord.documents.Count = 0 Then appWord.Quit
Application.DisplayAlerts = True
Set docTest = Nothing
Set appWord = Nothing
End Sub