Dann hier für morgen. Wenn du das Array umbaust (Bsp. mit verkürztem Array). Muss auf i anders zugegriffen werden. s. unten. So das wars. Dann :-) VG
Dim AbsBM As Variant
AbsBM = Array("TM_Vorname", 2, "TM_Vorname2", 2)
lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile überschriften stehen
With oExcelWorkbook.Sheets(DatAbsender)
Do While .Cells(lZeile, 2) <> ""
'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle
'übereinstimmt, dann werden die Textmarken gefüllt!
If ListBox1.Text = CStr(.Cells(lZeile, 1).Value) Then
'Eintrag gefunden, Textmarken füllen
'deine 8 Bookmarks würde ich in der SChleife abarbeiten
For i = 0 To 17 Step 2
'Fehlerbehandlung falls BM nicht existiert fehlt, jetzt wird da einfach nur nix gemacht
If ActiveDocument.Bookmarks.Exists(AbsBM(i)) Then
Set TMRange = ActiveDocument.Bookmarks(AbsBM(i)).Range
TMRange = CStr(.Cells(lZeile, AbsBM(i + 1)).Value)
ActiveDocument.Bookmarks.Add AbsBM(i), TMRange
Set TMRange = Nothing
End If
Next i
Exit Do
End If
lZeile = lZeile + 1
Loop
End With
|