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, 4360 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 ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (21)

Frage von Xaero1982 zum Thema Microsoft ...

Windows Update
Treiberinstallation durch Windows Update läßt sich nicht verhindern (17)

Frage von liquidbase zum Thema Windows Update ...

Windows Tools
gelöst Aussendienst Datensynchronisierung (12)

Frage von lighningcrow zum Thema Windows Tools ...

Windows Server
RODC über VPN - Verbindung weg (10)

Frage von stefan2k1 zum Thema Windows Server ...