Word - UserForm - ComboBox - TextBoxen - Daten aus Excel ziehen...

Eine Userform in Word. Die Combobox wird mit Daten aus Excel gefüllt. Bei Auswahl eines Namens werden die Textboxen mit den zugehörigen Daten befüllt. Die Exceldatei wird zu Beginn ausgeblendet geöffnet und beendet, wenn die Userform geschlossen wird. Die Word- und Exceldatei müssen im gleichen Verzeichnis sein.

A UserForm in Word. The combo box is filled with data from Excel. When you select a name, the text boxes are filled with the corresponding data. The Excel file is opened hidden at the start and ends when the UserForm is closed. The Word and Excel file must be in the same directory.

Hier noch eine Beispieldatei / Here's a sample file:
Word - UserForm - ComboBox - TextBoxen - Daten aus Excel ziehen...[ZIP 35 KB]

' Variablendeklaration erforderlich
Option Explicit
' Konstanten - da Late Binding also KEIN Verweis auf Excelbibliothek
Const xlFormulas = -4123
Const xlColumns = 2
Const xlUp = -4162
Const xlWhole = 1
'--------------------------------------------------------------------------
' Module    : UserForm1
' Procedure : UserForm_Initialize
' Author    : © Case (Ralf Stolzenburg)
' Date      : 22.08.2015
' Purpose   : Excel öffnen, Daten aus Adressliste per Find ziehen...
'--------------------------------------------------------------------------
' Variablendeklaration ausserhalb - weil auch andere Prozeduren zugreifen
    Dim lngLastRow As Long
    Dim objSheet As Object
    Dim blnTMP As Boolean
    Dim objExel As Object
Private Sub UserForm_Initialize()
    ' Variablendeklaration
    Dim lngTMP As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Exceldatei ausgeblendet öffnen
    Set objExel = GetObject(ThisDocument.Path & "\AdressListe.xls")
    ' Zugriff auf das erste Tabellenblatt
    Set objSheet = objExel.Worksheets(1)
    ' Oder mit Namen
    'Set objSheet = objExel.WorkSheets("Adressen")
    With objSheet
        ' letzte belegte Zeile im Excelsheet in Spalte A ermitteln
        lngLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
            .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        ComboBox1.Clear
        ' Erster Eintrag in der Combobox
        ComboBox1.AddItem ("Auswahl...")
        ' Schleife um die Combobox zu befüllen
        For lngTMP = 2 To lngLastRow
            ComboBox1.AddItem (.Range("A" & lngTMP))
        Next lngTMP
        ' Combobox auf ersten Eintrag setzen
        ComboBox1.ListIndex = 0
    End With
    blnTMP = True
Fin:
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Private Sub ComboBox1_Change()
    ' Variablendeklaration
    Dim lngTMP As Long
    Dim lngRow As Long
    On Error GoTo Fin
    ' Da schon beim befüllen der Combobox das Change-Event ausgeführt
    ' wird - hier unterbunden mit einer Boolean-Variablen
    If blnTMP Then
        ' Wenn nicht der erste Eintrag angezeigt wird dann...
        If ComboBox1.ListIndex > 0 Then
            ' Finde in Excel die Zeile mit dem Inhalt von Combobox1
            lngRow = objSheet.Range("A2:A" & lngLastRow).Find _
                (ComboBox1.Value, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlColumns).Row
            ' Befülle die Textboxen mit den korrespondierenden Werten
            For lngTMP = 1 To 4
                Me.Controls("TextBox" & lngTMP).Text = _
                    objSheet.Cells(lngRow, lngTMP + 1).Text
            Next lngTMP
        Else
            ' Sonst also wenn Auswahl... bzw. Listindex <=0 dann Textboxen leeren
            For lngTMP = 1 To 4
                Me.Controls("TextBox" & lngTMP).Text = ""
            Next lngTMP
        End If
    End If
Fin:
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Private Sub CommandButton1_Click()
    ' Userform beenden
    Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' Wenn NICHT das "x" geklickt wurde dann...
    If CloseMode <> 0 Then
        ' Excel schliessen
        objExel.Close False
        ' Objektvariable leeren
        Set objSheet = Nothing
        Set objExel = Nothing
    Else
        ' Sonst mache nichts bzw. breche das beenden ab
        Cancel = True
    End If
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...