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