Office: Dropdownelement in Word mit Daten aus Excel füllen

webspace001 · 17. Oktober 2012

Hallo zusammen,

ich habe eine Excel-Tabelle voller Adressen. Nun möchte ich gerne in Word ein Dropdown-Element erstellen, in dem mir der Inhalt der 1sten Spalte des Excel-Dokuments (Firmenname) aufgeführt wird. Wähle ich die gewünschte Firma über das DD-Element aus, so soll die dazugehörige Anschrift in Textformularfelder oder vergleichbaren Steuerelementen automatisch ausgegeben werden.

Die Anschriften bestehen dabei (in der Excel-Sheet) aus jeweils einer Spalte - Spalte B für Strasse, Spalte C für die PLZ und Spalte D für den Ort.

Mit Hilfe einer ListBox habe ich das Gewünschte bereits umsetzen können.

Code:

Dim i As Long
Dim oExc As Excel.Application
Dim oWrk As Excel.Workbook
Dim oSht As Excel.Worksheet
Set oExc = CreateObject("Excel.application")
Set oWrk = oExc.Workbooks.Open("X:\VBA\Spielwiese\Firmenliste.xls")
Set oSht = oWrk.Worksheets(1)
i = 1
ListBox1.Clear
While oSht.Cells(i, 1) ""
ListBox1.AddItem "Test"
ListBox1.List(i - 1, 0) = oSht.Cells(i, 1).Value
ListBox1.List(i - 1, 1) = oSht.Cells(i, 2).Value
ListBox1.List(i - 1, 2) = oSht.Cells(i, 3).Value
ListBox1.List(i - 1, 3) = oSht.Cells(i, 4).Value
i = i + 1
Wend
oExc.Quit
Set oExc = Nothing
End Sub

Private Sub ListBox1_Click()
Dim rTmp As Range
Dim sTmp As Range
Dim tTmp As Range
Set rTmp = ActiveDocument.Bookmarks("txtStrasse").Range
Set sTmp = ActiveDocument.Bookmarks("txtPLZ").Range
Set tTmp = ActiveDocument.Bookmarks("txtOrt").Range
rTmp.Text = ListBox1.List(ListBox1.ListIndex, 1)
sTmp.Text = ListBox1.List(ListBox1.ListIndex, 2)
tTmp.Text = ListBox1.List(ListBox1.ListIndex, 3)
rTmp.Bookmarks.Add "txtStrasse"
sTmp.Bookmarks.Add "txtPLZ"
tTmp.Bookmarks.Add "txtOrt"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nun soll die ganze Funktion aber auf ein DD-Element umgemünzt werden, da die Handhabung und Darstellung für das Projekt doch angemessener erscheint.

Danke für eure Unterstützung!
Mario

:)

M Merlin · 19. Oktober 2012

Mit einer Combo sollte das so gehn...

Code:

Sub ComboFüllen()
Dim i As Long
Dim oExc As Excel.Application
Dim oWrk As Excel.Workbook
Dim oSht As Excel.Worksheet
Dim Arr() As String
Const xlDown As Integer = -4121 ' Es kann sein, dass du die Konstante nicht deklarieren musst...

Set oExc = CreateObject("Excel.application")
Set oWrk = oExc.Workbooks.Open("X:\VBA\Spielwiese\Firmenliste.xls")
Set oSht = oWrk.Worksheets(1)

ReDim Arr(oSht.Cells(1, 1).End(xlDown).Row - 1, 3)
i = 1
While oSht.Cells(i, 1) ""
Arr(i - 1, 0) = oSht.Cells(i, 1).Value
Arr(i - 1, 1) = oSht.Cells(i, 2).Value
Arr(i - 1, 2) = oSht.Cells(i, 3).Value
Arr(i - 1, 3) = oSht.Cells(i, 4).Value

i = i + 1
Wend

With Me.ComboBox1
.Clear
.ColumnCount = 4
.BoundColumn = 4
.List = Arr
End With
oExc.Quit
Set oExc = Nothing
End Sub

Private Sub ComboBox1_Change()
Dim rTmp As Range
Dim sTmp As Range
Dim tTmp As Range

If ComboBox1.ListIndex = -1 Then Exit Sub
Set rTmp = ActiveDocument.Bookmarks("txtStrasse").Range
Set sTmp = ActiveDocument.Bookmarks("txtPLZ").Range
Set tTmp = ActiveDocument.Bookmarks("txtOrt").Range
rTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 1)
sTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 2)
tTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 3)
rTmp.Bookmarks.Add "txtStrasse"
sTmp.Bookmarks.Add "txtPLZ"
tTmp.Bookmarks.Add "txtOrt"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

webspace001 · 21. Oktober 2012

Hallo M Merlin,

der Weg mit der ComboBox klappt ausgezeichnet - Danke! Und ja, die Konstante musste ich nicht deklarieren.

An einer Sache beiße ich mir jedoch noch die Zähne aus: Es gibt bei bestimmten Firmen Ansprechpartner - nicht bei allen Firmen! Hierfür habe ich eine Textmarke names "txtAP" angelegt. Wenn in der zu Grunde liegenden Spalte (der Excel-Tabelle) kein Ansprechpartner vorgegeben ist, so soll er die Textmarke (in der Anschrift) auch nicht einfügen. Stand der Dinge ist, dass im Dokument quasi eine Leerzeile in der Anschrift auftaucht, sobald kein Ansprechpartner vorhanden ist. Ziel soll es jedoch sein, dass - wenn kein AP vorhanden - der Rest der Anschrift (Strasse, PLZ & Ort) entsprechend eine Zeile nach oben rutscht.

Gewissermaßen:

If Not IsNull(txtAP):
- Firmenname
- Ansprechpartner
- Strasse

- PLZ, Ort

Else:
- Firmenname
- Strasse

- PLZ, Ort

Folgender Versuch löscht leider grundsätzlich die Textmarke - auch wenn in pTmp ein String vorhanden ist?!
Code:

If pTmp.Text = "" Then
pTmp.Delete
EndIf
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

M Merlin · 22. Oktober 2012

Folgender Versuch löscht leider grundsätzlich die Textmarke - auch wenn in pTmp ein String vorhanden ist?!

Code:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

If pTmp.Text = "" Then
pTmp.Delete
EndIf
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das kann eigentlich nicht sein. Bist du denn schon mal im Einzelschrittmodus durchgegangen und hast die wirklich den Inhalt von pTmp.text anzeigen lassen, ob da wirklich nichts drin steht !!!

Eine Idee wäre, wenn du den Ansprechpartner ebenfalls nach dem Muster Code:

Arr(i - 1, 4)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

in das Array schreibst, das du das Array zur Prüfung heranziehst und nicht das Textfeld...

Also z.B.

Code:

If Arr(i - 1, 4) = "" Then
pTmp.Delete
EndIf
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

webspace001 · 22. Oktober 2012

Wenn ich dein Codeschnippsel übernehmen möchte, bekomme ich die Hinweismeldung, dass der "Index außerhalb des gültigen Bereichs" liegt *confused.gif* Wo genau muss ich den Code denn unterbringen?

In der Zwischenzeit hatte ich es mit folgendem Code probiert gehabt, der mir mir zwar wunderbar die Textmarke löscht,
Code:

If ComboBox1.List(ComboBox1.ListIndex, 1) = "" Then
ActiveDocument.Bookmarks("txtAP").Range.Paragraphs(1).Range.Delete
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ABER sobald ich jedoch über die ComboBox eine andere Adresse auswähle - mit Ansprechpartner - wird dieser String nicht mehr aufgeführt. Klar, die Textmarke ist zuvor ja auch durch den Datensatz ohne AP gelöscht worden. Wenn ich das Spiel fortführe (wieder zwischen Datensatz ohne und mit AP wähle), wird mir die nächste Zeile gelöscht (Leerzeile zwischen Strasse und PLZ/Ort).

M Merlin · 22. Oktober 2012

Mir ist dein Code im Moment nicht mehr so ganz klar...
Wenn ich das bisher verstanden habe, erzeugst du per Click-Ereignis der Combobx die Textmarken...
...aber warum willst du die dann wieder löschen. Warum erzeugst du denn überhaupt eine, du könntest doch auch eine leere Zeile Einfügen, die due wenn du einen Ap hast wieder löscht und dort eine Textmarke hinzufügst...

Zeig vielleicht mal deinen bisherigen gesamten Code oder vlt. sogar nen Beispiel...

webspace001 · 22. Oktober 2012

Guten Morgen M Merlin,

im Folgenden der bisherige Code.
Code:

Private Sub UserForm_Initialize()
Dim i As Long
Dim oExc As Excel.Application
Dim oWrk As Excel.Workbook
Dim oSht As Excel.Worksheet
Dim Arr() As String

Set oExc = CreateObject("Excel.application")
Set oWrk = oExc.Workbooks.Open("X:\VBA\Spielwiese\Firmenliste.xls")
Set oSht = oWrk.Worksheets(1)

ReDim Arr(oSht.Cells(1, 1).End(xlDown).Row - 1, 4)
i = 1
While oSht.Cells(i, 1) ""
Arr(i - 1, 0) = oSht.Cells(i, 1).Value
Arr(i - 1, 1) = oSht.Cells(i, 2).Value
Arr(i - 1, 2) = oSht.Cells(i, 3).Value
Arr(i - 1, 3) = oSht.Cells(i, 4).Value
Arr(i - 1, 4) = oSht.Cells(i, 5).Value

i = i + 1
Wend

With Me.ComboBox1
.Clear
.ColumnCount = 4
.BoundColumn = 4
.List = Arr
End With
oExc.Quit
Set oExc = Nothing
End Sub

Private Sub ComboBox1_Change()

Dim pTmp As Range
Dim qTmp As Range
Dim rTmp As Range
Dim sTmp As Range
Dim tTmp As Range
Dim Arr() As String

If ComboBox1.ListIndex = -1 Then Exit Sub

Set pTmp = ActiveDocument.Bookmarks("txtFA").Range
Set qTmp = ActiveDocument.Bookmarks("txtAP").Range
Set rTmp = ActiveDocument.Bookmarks("txtStrasse").Range
Set sTmp = ActiveDocument.Bookmarks("txtPLZ").Range
Set tTmp = ActiveDocument.Bookmarks("txtOrt").Range

If ComboBox1.List(ComboBox1.ListIndex, 1) = "" Then
ActiveDocument.Bookmarks("txtAP").Range.Paragraphs(1).Range.Delete
End If

pTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 0)
qTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 1)
rTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 2)
sTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 3)
tTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 4)
pTmp.Bookmarks.Add "txtFA"
qTmp.Bookmarks.Add "txtAP"
rTmp.Bookmarks.Add "txtStrasse"
sTmp.Bookmarks.Add "txtPLZ"
tTmp.Bookmarks.Add "txtOrt"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn ich das bisher verstanden habe, erzeugst du per Click-Ereignis der Combobx die Textmarken...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn du mit "erzeugen" das Zuweisen von Strings aus dem Array über die ComboBox meinst, dann ja. Angelegt worden die Textmarken jedoch schon vorab (beim Erstellen der Vorlage angelegt). Dbzgl. habe ich ja auch schon überlegt, ob ich nicht grundsätzlich ohne der Textmarke (txtAP) für den Ansprechpartner arbeitet und bei einem vorhandenen Datensatz mit Ansprechpartner eine Textmarke per Code einfügt wird.

Zur Klärung/Zielstellung: Es soll eine Word-Vorlage entstehen, bei der eingangs die Adresse im Briefkopf über eine Userform ausgewählt werden kann. Hierzu wurden die verschiedenen Adressen in einem Excel-Sheet hinterlegt, die - dank deiner Hilfe - über eine ComboBox resp. ein Array eingelesen und den entsprechenden Textmarken zugeordnet werden.

- txtFA (Firmenname)
- txtAP (Ansprechpartner)
- txtStrasse (Strasse)
- txtPLZ (Postleitzahl)
- txtOrt (Ort)

Die Besonderheit dabei ist, dass, wenn es eine Anschrift/Adresse ohne Ansprechpartner gibt, die Textmarke qasi gelöscht wird, damit am Ende zwischen Firmenname und Strasse keine Leerzeile in der Adresse auftaucht. Die offensichtliche Herausforderung ist die, dass, wenn der Benutzer versehentlich eine Adresse ohne Ansprechpartner wählt (und dabei die Textmarke gelöscht wird) und im nächsten Schritt eine Adresse mit Ansprechpartner auswählt, die Textmarke wieder gesetzt werden muss.

IST-Stand ist der, dass, sobald eine Adresse ohne Ansprechpartner gewählt wird, das 1ste Mal sauber die Textmarke gelöscht wird (damit keine Leerzeile zwischen Firmenname und Strasse auftaucht. Wenn ich aber anschließend wieder auf eine Firmenadresse mit AP umswitche, wird der AP nicht aufgeführt, da zuvor ja die Textmarke gelöscht worde. Und das darf nicht sein, da man ja immer mal bei der Auswahl die falsche Adresse (ohne/mit AP) auswählen könnte.

Vielleich gibt es ja aber auch einen völlig anderen Weg ("nach Rom), der die Zielsetzung erfüllt?!

M Merlin · 22. Oktober 2012

Siehe PN

webspace001 · 22. Oktober 2012

Siehe Anhang

Danke, M Merlin!

PS: Bitte beachte, dass ich den Code noch nicht dahingehend angepasst habe, dass nach dem Schließen des .doc auch Excel automatisch beendet wird.

M Merlin · 22. Oktober 2012

Nimm mal aus deinem Worddokument die Textmarke txtAP wieder raus und ersetze den Code für das Change-Ereignis der Combo:

Code:

Private Sub ComboBox1_Change()

Dim pTmp As Range
Dim qTmp As Range
Dim rTmp As Range
Dim sTmp As Range
Dim tTmp As Range
Dim Arr() As String
Dim rng As Word.Range

If ComboBox1.ListIndex = -1 Then Exit Sub

Set pTmp = ActiveDocument.Bookmarks("txtFA").Range
Set rTmp = ActiveDocument.Bookmarks("txtStrasse").Range
Set sTmp = ActiveDocument.Bookmarks("txtPLZ").Range
Set tTmp = ActiveDocument.Bookmarks("txtOrt").Range

If ComboBox1.List(ComboBox1.ListIndex, 1) = "" Then
If ActiveDocument.Bookmarks.Exists("txtAP") Then
ActiveDocument.Bookmarks("txtAP").Range.Paragraphs(1).Range.Delete
End If
Else
If ActiveDocument.Bookmarks.Exists("txtFA") Then
If Not ActiveDocument.Bookmarks.Exists("txtAP") Then
Set rng = ActiveDocument.Bookmarks("txtFA").Range
rng.Collapse wdCollapseEnd
rng.InsertAfter vbCrLf & ActiveDocument.Bookmarks("txtFA")
rng.MoveStart Unit:=wdParagraph, Count:=1
rng.Text = "txtAP"
rng.Bookmarks.Add Name:="txtAP", Range:=rng
End If
End If
Set qTmp = ActiveDocument.Bookmarks("txtAP").Range
qTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 1)
qTmp.Bookmarks.Add "txtAP"
End If

pTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 0)
rTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 2)
sTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 3)
tTmp.Text = ComboBox1.List(ComboBox1.ListIndex, 4)
pTmp.Bookmarks.Add "txtFA"
rTmp.Bookmarks.Add "txtStrasse"
sTmp.Bookmarks.Add "txtPLZ"
tTmp.Bookmarks.Add "txtOrt"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

webspace001 · 22. Oktober 2012

M Merlin, ich kann mich auf diesem Weg (leider) nur verneigen und Danke sagen! Habe deinen Code übernommen und es funktioniert so, wie es sein soll.

Wirklich, vielen herzlichen Dank für deine Bemühungen!

Jetzt muss ich deinen Code erstmal eingehend erforschen *wink.gif*

M Merlin · 22. Oktober 2012

Jetzt muss ich deinen Code erstmal eingehend erforschen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich habe nur eine Textmarke eingefügt wenn sie benötigt wird..
..und zwar hinter der Textmarke txtFA.
Un dann habe ich noch geprüft ob eine Textmarke txtAP vorhanden ist. Falls ja dann löschen wenn sie niocht benötigt wird...

Das ist alles *cool.gif*

Schluffieword · 19. Dezember 2013

Hallo ZUsammen,

das ist genau das, was ich suche. Leider hab ich NUll Ahnung von VBA.
Wo muss ich das genau unterbringen?

Danke
Schluffie

Office: Dropdownelement in Word mit Daten aus Excel füllen

Dropdownelement in Word mit Daten aus Excel füllen

Dropdownelement in Word mit Daten aus Excel füllen

Dropdownelement in Word mit Daten aus Excel füllen

Dropdownelement in Word mit Daten aus Excel füllen

Dropdownelement in Word mit Daten aus Excel füllen

Dropdownelement in Word mit Daten aus Excel füllen - Similar Threads - Dropdownelement Word Daten

WORD : einfügen von Pfeilen und Co. aus zwischenspeicher in ein Bild welches in einer Tabelle eingef

Formatierung inkl. Textmarken der übertragenen Word-Datei mit über-nehmen

Word-Dateien über Excel in eine ausgewählte Word-Datei übertragen per Makro

Download von Microsoft Word 365

Bereich zweimal in Word einfügen (VBA)

Format Übertragung im Microsoft Word und Excel

Word 365 Index ohne Fußnoten