VBA Word - Lieferanten aus Excel in Listbox lesen

Hallo

ich möchte aus einer UserForm in Word auf Lieferantennamen in Excel zugreifen.
Konkret möchte ich hier alle Lieferanten, die den Suchstring im Textfeld "LiefSuche" beinhalten, in der ListBox "LiefListBox" auflisten.
Im weiten Schritt möchte ich dann die Adresse eines in der ListBox ausgewählten Lieferanten in den Brief übernehmen.
Das funktioniert soweit auch, jedoch fängt die Schleife immer wieder von neuem an (Endlos-Schleife).

Da ich mich mit der Kommunikation mittels VBA zwischen Word und Excel noch nicht so gut auskenne, würde mich interessieren, was am Code falsch ist:

Private Sub LiefSuche_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim appExcel As Excel.Application
Dim wbkExcel As Excel.Workbook
Dim wksExcel As Excel.Worksheet
Dim rngExcel As Excel.Range
Dim rngCell As Range
Dim strFirstAddress As String
Dim Suchwort As String

Set appExcel = Excel.Application
Set wbkExcel = Excel.Workbooks.Open("C:\Test\Lieferanten\Adressen.xlsx")  
Set wksExcel = Excel.Worksheets("Adressen")  
Set rngExcel = wksExcel.UsedRange
   
Suchwort = ("*" & UserForm1.LiefSuche.Value & "*")  
UserForm1.LiefListBox.Clear
With wksExcel.Range("B:B")  
Set rngExcel = .Find(Suchwort, LookIn:=xlValues, lookat:=xlWhole)
If Not rngExcel Is Nothing Then
strFirstAddress = rngExcel.Application
Do
With UserForm1.LiefListBox
.ColumnCount = 1
.AddItem
.List(.ListCount - 1, 0) = rngExcel.Text
.ColumnWidths = "15cm"  
End With
Set rngExcel = .FindNext(rngExcel)
Loop Until rngExcel Is Nothing And rngExcel <> strFirstAddress
Else
End If
End With

Vielen Dank vorab

[Edit Biber] Nachträgliche Codetags - bringen jetzt leider nur noch Zeilennummern, keine Einrückungen mehr.. [/Edit]

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 231518

Url: https://administrator.de/forum/vba-word-lieferanten-aus-excel-in-listbox-lesen-231518.html

Ausgedruckt am: 06.04.2025 um 14:04 Uhr

5 Kommentare

Neuester Kommentar

Moin mreske,

bist du dir sicher, dass es in Zeile 20 strFirstAddress = rngExcel.Application heissen sollte?
Und das die Loop-Verlassen-Bedingung wirklich rngExcel Is Nothing And rngExcel <> strFirstAddress lauten muss?

Grüße
Biber

Hallo mreske, Willkommen im Forum!
Du meintest in Zeile 20 wahrscheinlich

strFirstAddress = rngExcel.Address

und in Zeile 29

Loop While Not rngExcel Is Nothing And rngExcel.Address <> strFirstAddress

Im weiten Schritt möchte ich dann die Adresse eines in der ListBox ausgewählten Lieferanten in den Brief übernehmen.

Das ist auch kein Problem. Das machst du am besten folgendermaßen: Du gibst deiner Listbox zusätzlich so viel Spalten wie du Adressteile benötigst, dann setzt du die Spaltenbreiten dieser Spalten auf 0 damit man sie nicht sehen kann. In deinem Loop mit dem du nach Adressen suchst fügst du dann die Adressteile wie Straße, Ort und PLZ deiner Listbox hinzu indem du mit einem Offset in Excel auf eine Benachbarte Zelle verweist in der diese Daten stehen:

.List(.ListCount - 1, 1) = rngExcel.Offset(0,1).Value      'Daten der zweiten Spalte setzen  
.List(.ListCount - 1, 2) = rngExcel.Offset(0,2).Value      'Daten der dritten Spalte setzen  
' usw. ...  

In diesem Beispiel die Zelle direkt rechts neben der aktuellen Zelle. Willst du z.B. nach einem Doppelklick auf den Eintrag, die Daten in eine Textstelle mit einer Textmarke (Tab: Einfügen > Hyperlinks > Textmarke) einfügen, kannst du das so machen:
(für die Rückgabe des Wertes der zweiten unsichtbaren Spalte in eine Textstelle mit der Textmarke 'PLZ', usw.):

Private Sub LiefListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ActiveDocument.Bookmarks("PLZ").Range.Text = LiefListBox.List(LiefListBox.ListIndex, 1)  
    ActiveDocument.Bookmarks("Ort").Range.Text = LiefListBox.List(LiefListBox.ListIndex, 2)  
    Me.Hide
End Sub

p.s. Und nicht vergessen hinterher das Excel-Dokument auch wieder zu schließen damit es nachher nicht im Hintergrund unsichtbar weiterläuft:

wbkExcel.Close False
appExcel.Quit
set appExcel = Nothing

Grüße Uwe

Hallo Uwe,
mann seid Ihr schnell! Mit einer so schnellen Antwort habe ich nun wirklich nicht gerechnet.

Also tausend Dank auch für die Beschreibung, wie man die Adresse in den Brief übernimmt.

Das werde ich morgen Abend gleich ausprobieren und den Code dann natürlich hier posten.

Vielen Dank und einen schönen Abend noch
Mreske

Hallo,
wie versprochen hier der komplette Code:
Im Word Dokument müssen natürlich vorher folgende Textmarken für die Lieferanten-Anschrift angelegt werden:
LiefName
LiefAnschrift
LiefLand
LiefPLZ
LiefOrt

Ausserdem muss in C:\Test\Lieferanten\ die Excel-Tabelle mit den Adressen (Adressen.xlsx) angelegt sein

Option Explicit
Private Sub LiefSuche_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' geht natürlich auch mit Change()
Dim appExcel As Excel.Application
Dim wbkExcel As Excel.Workbook
Dim wksExcel As Excel.Worksheet
Dim rngExcel As Excel.Range
Dim rngCell As Range
Dim strFirstAddress As String
Dim Suchwort As String

Set appExcel = Excel.Application
Set wbkExcel = Excel.Workbooks.Open("C:\Test\Lieferanten\Adressen.xlsx")
Set wksExcel = Excel.Worksheets("Adressen")
Set rngExcel = wksExcel.UsedRange

Suchwort = ("*" & BestelldatenWord.LiefSuche.Value & "*")
BestelldatenWord.LiefListBox.Clear
With wksExcel.Range("B:B")
Set rngExcel = .Find(Suchwort, LookIn:=xlValues, lookat:=xlWhole)
If Not rngExcel Is Nothing Then
strFirstAddress = rngExcel.Address
Do
With BestelldatenWord.LiefListBox
.ColumnCount = 5
.AddItem
.List(.ListCount - 1, 0) = rngExcel.Text 'LieferantenName
.List(.ListCount - 1, 1) = rngExcel.Offset(0, 1).Value 'LiefAnschrift
.List(.ListCount - 1, 2) = rngExcel.Offset(0, 2).Value 'LiefLand
.List(.ListCount - 1, 3) = rngExcel.Offset(0, 3).Value 'LiefPLZ
.List(.ListCount - 1, 4) = rngExcel.Offset(0, 4).Value 'LiefOrt
.ColumnWidths = "8cm;5cm;1cm;2cm;3cm"
End With
Set rngExcel = .FindNext(rngExcel)
Loop While Not rngExcel Is Nothing And rngExcel.Address <> strFirstAddress
Else
End If
End With
wbkExcel.Close False
appExcel.Quit
Set appExcel = Nothing
End Sub

Private Sub LiefListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim LiefName As String
Dim LiefAnschrift As String
Dim LiefLand As String
Dim LiefPLZ As String
Dim LiefOrt As String
Dim Bereich As Range

LiefName = LiefListBox.List(LiefListBox.ListIndex, 0)
LiefAnschrift = LiefListBox.List(LiefListBox.ListIndex, 1)
LiefLand = LiefListBox.List(LiefListBox.ListIndex, 2)
LiefPLZ = LiefListBox.List(LiefListBox.ListIndex, 3)
LiefOrt = LiefListBox.List(LiefListBox.ListIndex, 4)

Set Bereich = ActiveDocument.Bookmarks("LiefName").Range
Bereich.Text = LiefName
ActiveDocument.Bookmarks.Add Name:="LiefName", Range:=Bereich

Set Bereich = ActiveDocument.Bookmarks("LiefAnschrift").Range
Bereich.Text = LiefAnschrift
ActiveDocument.Bookmarks.Add Name:="LiefAnschrift", Range:=Bereich

Set Bereich = ActiveDocument.Bookmarks("LiefLand").Range
Bereich.Text = LiefLand
ActiveDocument.Bookmarks.Add Name:="LiefLand", Range:=Bereich

Set Bereich = ActiveDocument.Bookmarks("LiefPLZ").Range
Bereich.Text = LiefPLZ
ActiveDocument.Bookmarks.Add Name:="LiefPLZ", Range:=Bereich

Set Bereich = ActiveDocument.Bookmarks("LiefOrt").Range
Bereich.Text = LiefOrt
ActiveDocument.Bookmarks.Add Name:="LiefOrt", Range:=Bereich

Me.Hide
End Sub

Gruß