Sub PDFerstellen()
Dim lobjWord As Object, lwrdDoc As Object, bWordVorhanden As Boolean
Dim strPDFName As String, sBrief As String, TPos As String
Range(Selection, ActiveCell.EntireRow).Select
strPDFName = "C:\Temp\Test\" & "Testdatei.pdf"
sBrief = "Test.doc"
TPos = ActiveCell.Address
Set lobjWord = CreateObject("Word.Application")
Set lwrdDoc = lobjWord.Documents.Add(sBrief)
Range(Selection, ActiveCell.EntireRow).Select
On Error Resume Next
With lwrdDoc
.Bookmarks("SpalteA").Range.Text = (ActiveCell.Offset(0, 0))
.Bookmarks("SpalteB").Range.Text = (ActiveCell.Offset(0, 1))
.Bookmarks("SpalteC").Range.Text = (ActiveCell.Offset(0, 2))
.Bookmarks("SpalteD").Range.Text = (ActiveCell.Offset(0, 3))
.Bookmarks("SpalteE").Range.Text = (ActiveCell.Offset(0, 4))
.PrintOut Copies:=0
.ExportAsFixedFormat OutputFileName:=strPDFName, _
ExportFormat:=17, _
OpenAfterExport:=True
.Close = False
.Saved = True
End With
Set lwrdDoc = Nothing
Set lobjWord = Nothing
Range(TPos).Select
End Sub