|
ich habs befürchtet, ganz so einfach ist es doch nicht
nun habe ich
lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile überschriften stehen
With oExcelWorkbook.Sheets(DatAbsender)
Do While .Cells(lZeile, 1) <> ""
'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle
'übereinstimmt, dann werden die Textmarken gefüllt!
If ListBox2.Text = CStr(.Cells(lZeile, 1).Value) Then
'Eintrag gefunden, Textmarken füllen
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
so hier abgeändert.
Dim AbsBM As Variant
AbsBM = Array("TM_Vorname", "TM_Vorname2", "TM_Nachname", "TM_Nachname2", "TM_StrHnr", "TM_PLZ", "TM_Ort", "TM_Tel", "TM_Mail")
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 8
'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, i + 3).Value)
ActiveDocument.Bookmarks.Add AbsBM(i), TMRange
Set TMRange = Nothing
End If
Next i
Exit Do
End If
lZeile = lZeile + 1
Loop
End With
Der Teufel liegt aber im Detail.
die schleife macht seine arbeit, aber dadurch das die spalten wo sich das dokument die daten holt,
diesmal nicht von 1- x angesprochen werden und stellenweise auch 2 mal benötigt werden füllt er die Textmarken falsch.
kann ich das im Aray AbsBM, wo die textmarken stehen irgend wie definieren?
|