Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

VBA Word - Lieferanten aus Excel in Listbox lesen

Frage Entwicklung VB for Applications

Mitglied: mreske

mreske (Level 1) - Jetzt verbinden

03.03.2014, aktualisiert 18:36 Uhr, 4429 Aufrufe, 5 Kommentare

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:

b910de53900826e38dd1ea8ba902383e - Klicke auf das Bild, um es zu vergrößern
01.
Private Sub LiefSuche_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
02.
Dim appExcel As Excel.Application 
03.
Dim wbkExcel As Excel.Workbook 
04.
Dim wksExcel As Excel.Worksheet 
05.
Dim rngExcel As Excel.Range 
06.
Dim rngCell As Range 
07.
Dim strFirstAddress As String 
08.
Dim Suchwort As String 
09.
 
10.
Set appExcel = Excel.Application 
11.
Set wbkExcel = Excel.Workbooks.Open("C:\Test\Lieferanten\Adressen.xlsx") 
12.
Set wksExcel = Excel.Worksheets("Adressen") 
13.
Set rngExcel = wksExcel.UsedRange 
14.
    
15.
Suchwort = ("*" & UserForm1.LiefSuche.Value & "*") 
16.
UserForm1.LiefListBox.Clear 
17.
With wksExcel.Range("B:B") 
18.
Set rngExcel = .Find(Suchwort, LookIn:=xlValues, lookat:=xlWhole) 
19.
If Not rngExcel Is Nothing Then 
20.
strFirstAddress = rngExcel.Application 
21.
Do 
22.
With UserForm1.LiefListBox 
23.
.ColumnCount = 1 
24.
.AddItem 
25.
.List(.ListCount - 1, 0) = rngExcel.Text 
26.
.ColumnWidths = "15cm" 
27.
End With 
28.
Set rngExcel = .FindNext(rngExcel) 
29.
Loop Until rngExcel Is Nothing And rngExcel <> strFirstAddress 
30.
Else 
31.
End If 
32.
End With
Vielen Dank vorab

[Edit Biber] Nachträgliche Codetags - bringen jetzt leider nur noch Zeilennummern, keine Einrückungen mehr.. [/Edit]
Mitglied: Biber
03.03.2014, aktualisiert um 19:11 Uhr
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
Bitte warten ..
Mitglied: colinardo
LÖSUNG 03.03.2014, aktualisiert um 18:36 Uhr
Hallo mreske, Willkommen im Forum!
Du meintest in Zeile 20 wahrscheinlich
01.
strFirstAddress = rngExcel.Address
und in Zeile 29
01.
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:
01.
.List(.ListCount - 1, 1) = rngExcel.Offset(0,1).Value      'Daten der zweiten Spalte setzen 
02.
.List(.ListCount - 1, 2) = rngExcel.Offset(0,2).Value      'Daten der dritten Spalte setzen 
03.
' 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.):
01.
Private Sub LiefListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 
02.
    ActiveDocument.Bookmarks("PLZ").Range.Text = LiefListBox.List(LiefListBox.ListIndex, 1) 
03.
    ActiveDocument.Bookmarks("Ort").Range.Text = LiefListBox.List(LiefListBox.ListIndex, 2) 
04.
    Me.Hide 
05.
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:
01.
wbkExcel.Close False 
02.
appExcel.Quit 
03.
set appExcel = Nothing
Grüße Uwe
Bitte warten ..
Mitglied: mreske
03.03.2014 um 18:41 Uhr
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
Bitte warten ..
Mitglied: mreske
08.03.2014 um 20:51 Uhr
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ß
Bitte warten ..
Mitglied: colinardo
08.03.2014, aktualisiert um 20:54 Uhr
Danke für deine Rückmeldung, dann setze deinen Code noch bitte in Tags . Merci.

Grüße Uwe
Bitte warten ..
Ähnliche Inhalte
Viren und Trojaner
gelöst Word und Excel per Mail gesperrt - Alternative? (7)

Frage von Coreknabe zum Thema Viren und Trojaner ...

Microsoft Office
gelöst CSV-Datei mit einem VBA Makro in Excel einlesen und leicht anpassen (5)

Frage von JoSiBa zum Thema Microsoft Office ...

Microsoft Office
Unterordner durchsuchen Excel VBA (1)

Frage von schwalbepilot zum Thema Microsoft Office ...

Neue Wissensbeiträge
Sicherheits-Tools

Sicherheitstest von Passwörtern für ganze DB-Tabellen

(1)

Tipp von gdconsult zum Thema Sicherheits-Tools ...

Peripheriegeräte

Was beachten bei der Wahl einer USV Anlage im Serverschrank

(9)

Tipp von zetboxit zum Thema Peripheriegeräte ...

Windows 10

Das Windows 10 Creators Update ist auf dem Weg

(6)

Anleitung von BassFishFox zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Batch & Shell
gelöst ZIP-Archive nach Dateien durchsuchen und Pfade ausgeben (33)

Frage von evinben zum Thema Batch & Shell ...

Router & Routing
Routingproblem in Homerouter-Kaskade mit Raspi (20)

Frage von Oldschool zum Thema Router & Routing ...

Exchange Server
Exchange 2016 Standard Server 2012 R2 Hetzner Mail (14)

Frage von Datsspeed zum Thema Exchange Server ...

Verschlüsselung & Zertifikate
Mit Veracrypt eine zweite interne (non-system) Festplatte verschlüsseln (9)

Frage von Bernulf zum Thema Verschlüsselung & Zertifikate ...