5
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:
Vielen Dank vorab
[Edit Biber] Nachträgliche Codetags - bringen jetzt leider nur noch Zeilennummern, keine Einrückungen mehr.. [/Edit]
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 WithVielen Dank vorab
[Edit Biber] Nachträgliche Codetags - bringen jetzt leider nur noch Zeilennummern, keine Einrückungen mehr.. [/Edit]
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 231518
Url: https://administrator.de/contentid/231518
Printed on: April 25, 2024 at 05:04 o'clock
5 Comments
Latest comment
Moin mreske,
bist du dir sicher, dass es in Zeile 20
Und das die Loop-Verlassen-Bedingung wirklich
Grüße
Biber
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
und in Zeile 29
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.):
p.s. Und nicht vergessen hinterher das Excel-Dokument auch wieder zu schließen damit es nachher nicht im Hintergrund unsichtbar weiterläuft:
Grüße Uwe
Du meintest in Zeile 20 wahrscheinlich
strFirstAddress = rngExcel.AddressLoop While Not rngExcel Is Nothing And rngExcel.Address <> strFirstAddressIm 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. ... (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 SubwbkExcel.Close False
appExcel.Quit
set appExcel = Nothing
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
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ß
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ß
