Private
Sub
CommandButton1_Click()
Dim
oExcelApp
As
Object
Dim
oExcelWorkbook
As
Object
Dim
lZeile
As
Long
Dim
i
As
Integer
If
ListBox1.ListIndex >= 0
Then
Set
oExcelApp = CreateObject(
"Excel.Application"
)
Set
oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
lZeile = 2
With
oExcelWorkbook.sheets(sTabellenblatt)
Do
While
.Cells(lZeile, 23) <>
""
If
ListBox1.Text =
CStr
(.Cells(lZeile, 23).Value)
Then
ActiveDocument.Bookmarks(
"Textmarke_Name"
).Range.Text = _
CStr
(.Cells(lZeile, 23).Value)
ActiveDocument.Bookmarks(
"Textmarke_Bereich"
).Range.Text = _
CStr
(.Cells(lZeile, 24).Value)
ActiveDocument.Bookmarks(
"Textmarke_Funktion"
).Range.Text = _
CStr
(.Cells(lZeile, 25).Value)
ActiveDocument.Bookmarks(
"Textmarke_Vorgesetzter"
).Range.Text = _
CStr
(.Cells(lZeile, 26).Value)
ActiveDocument.Bookmarks(
"Textmarke_L_1"
).Range.Text = _
CStr
(.Cells(lZeile, 3).Value)
ActiveDocument.Bookmarks(
"Textmarke_L_2"
).Range.Text = _
CStr
(.Cells(lZeile, 4).Value)
ActiveDocument.Bookmarks(
"Textmarke_L_3"
).Range.Text = _
CStr
(.Cells(lZeile, 5).Value)
ActiveDocument.Bookmarks(
"Textmarke_L_4"
).Range.Text = _
CStr
(.Cells(lZeile, 6).Value)
Exit
Do
End
If
lZeile = lZeile + 1
Loop
End
With
oExcelWorkbook.Close
False
oExcelApp.Quit
Else
MsgBox
"Bitte wählen Sie einen Eintrag aus der Liste aus!"
, _
vbInformation + vbOKOnly,
"HINWEIS!"
Exit
Sub
End
If
Set
oExcelWorkbook =
Nothing
Set
oExcelApp =
Nothing
Unload
Me
End
Sub