Private Sub CommandButton1_Click()
Dim oExcelApp As Object
Dim oExcelWorkbook As Object
Dim lZeile As Long
Set oExcelApp = CreateObject("Excel.Application")
Set oExcelWorkbook = oExcelApp.Workbooks.Open(ThisDocument.Path & DatenBezug)
meineBM = Array("TM_E_Firma", "TM_E_StrHnr", "TM_E_PLZ", "TM_E_Ort", "TM_E_Tel", "TM_E_Fax", "TM_E_Mail", "TM_E_KD")
lZeile = 2
With oExcelWorkbook.Sheets(DatEmpfaenger)
Do While .Cells(lZeile, 2) <> ""
If ListBox1.Text = CStr(.Cells(lZeile, 1).Value) Then
For i = 0 To 7
If ActiveDocument.Bookmarks.Exists(meineBM(i)) Then
Set TMRange = ActiveDocument.Bookmarks(meineBM(i)).Range
TMRange = CStr(.Cells(lZeile, i + 3).Value)
ActiveDocument.Bookmarks.Add meineBM(i), TMRange
Set TMRange = Nothing
End If
Next i
Exit Do
End If
lZeile = lZeile + 1
Loop
End With
lZeile = 2
With oExcelWorkbook.Sheets(DatAbsender)
Do While .Cells(lZeile, 1) <> ""
If ListBox2.Text = CStr(.Cells(lZeile, 1).Value) Then
ActiveDocument.Bookmarks("TM_Vorname").Range = _
CStr(.Cells(lZeile, 2).Value)
ActiveDocument.Bookmarks("TM_Vorname2").Range = _
CStr(.Cells(lZeile, 2).Value)
ActiveDocument.Bookmarks("TM_Nachname").Range = _
CStr(.Cells(lZeile, 3).Value)
ActiveDocument.Bookmarks("TM_Nachname2").Range = _
CStr(.Cells(lZeile, 3).Value)
ActiveDocument.Bookmarks("TM_StrHnr").Range = _
CStr(.Cells(lZeile, 4).Value)
ActiveDocument.Bookmarks("TM_PLZ").Range = _
CStr(.Cells(lZeile, 5).Value)
ActiveDocument.Bookmarks("TM_Ort").Range = _
CStr(.Cells(lZeile, 6).Value)
ActiveDocument.Bookmarks("TM_Tel").Range = _
CStr(.Cells(lZeile, 7).Value)
ActiveDocument.Bookmarks("TM_Mail").Range = _
CStr(.Cells(lZeile, 8).Value)
Exit Do
End If
lZeile = lZeile + 1
Loop
End With
lZeile = 2
With oExcelWorkbook.Sheets(DatTxtBausteine)
Do While .Cells(lZeile, 1) <> ""
If ListBox3.Text = CStr(.Cells(lZeile, 1).Value) Then
ActiveDocument.Bookmarks("TM_Betreff").Range = _
CStr(.Cells(lZeile, 3).Value)
Exit Do
End If
lZeile = lZeile + 1
Loop
End With
lZeile = 2
With oExcelWorkbook.Sheets(DatTxtBausteine2)
Do While .Cells(lZeile, 1) <> ""
If ListBox4.Text = CStr(.Cells(lZeile, 1).Value) Then
ActiveDocument.Bookmarks("TM_Inhalt").Range = EinfTxtBox.Text
Exit Do
End If
lZeile = lZeile + 1
Loop
End With
oExcelWorkbook.Close False
oExcelApp.Quit
Set oExcelWorkbook = Nothing
Set oExcelApp = Nothing
If CheckBox1.Value = True Then
Call GrafikEinfügen
End If
Unload Me
End Sub