Hallo,
i.Gr. kannst Du die Font_Eig. einfach hinten dran heften, das kannst Du gut mit einer kl. Sub-Proc machen:
'...
Dim objRange As Range
'...
With oExcelWorkbook.Sheets(sTabellenblatt)
Do While .Cells(lZeile, 1) <> ""
If ListBox1.Text = CStr(.Cells(lZeile, 2).Value) Then
Set objRange = ActiveDocument.Bookmarks("Textmarke_Name ").Range
With .Cells(lZeile, 2)
objRange.Text = CStr(.Value)
Call Font_Transfer(probjRange:=objRange, probjXlFont:=.Font)
End With
Set objRange = ActiveDocument.Bookmarks("Textmarke_ID").Range
With .Cells(lZeile, 1)
objRange.Text = CStr(.Value)
Call Font_Transfer(probjRange:=objRange, probjXlFont:=.Font)
End With
Set objRange = ActiveDocument.Bookmarks("Textmarke_Beschreibung").Range
With .Cells(lZeile, 3)
objRange.Text = CStr(.Value)
Call Font_Transfer(probjRange:=objRange, probjXlFont:=.Font)
End With
Set objRange = Nothing
Exit Do
End If
lZeile = lZeile + 1
Loop
End With
'....
End Sub
'....
Private Sub Font_Transfer(ByRef probjRange As Range, ByRef probjXlFont As Object)
With probjXlFont
probjRange.Color = .Color
probjRange.Bold = .Bold
probjRange.Name = .Name
End With
End Sub
Gruß,
|