Nur Formularfelder drucken nach Datenimport

Option Explicit

'Diese Konstanten speichert  
'den Pfad und den Dateinamen der Adressliste (Excel)  
'Bitte entsprechend anpassen!  
Private Const sAdressDatei As String = _
    "H:\Datenanalyse_Systembetreuung\Freischaltungen_2016\Entwicklung\Vorlagen\Word_Formular-Exel\MeineAdressen.xlsx"  

'Wie heisst das Tabellenblatt, auf welchem sich die Adressen befinden?  
'Bitte entsprechend anpassen!  
Private Const sTabellenblatt As String = "Tabelle1"  

Private Sub CommandButton1_Click()
  Dim oExcelApp As Object
  Dim oExcelWorkbook As Object
  Dim lZeile As Long
  
    'Nur wenn ein Eintrag in der Liste markiert ist, wird das Makro ausgefŸhrt  
    If ListBox1.ListIndex >= 0 Then
    
        'Zuerst wird die Excel Datei gešffnet  
        Set oExcelApp = CreateObject("Excel.Application")  
        Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
    
        lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile †berschriften stehen  
        With oExcelWorkbook.sheets(sTabellenblatt)
            Do While .Cells(lZeile, 1) <> ""  
                'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle  
                'Ÿbereinstimmt, dann werden die Textmarken gefŸllt!  
                If ListBox1.Text = CStr(.Cells(lZeile, 2).Value) Then
                    'Eintrag gefunden, Textmarken fŸllen  
                    ActiveDocument.FormFields("Name").Range.Text = _  
                        CStr(.Cells(lZeile, 2).Value)
                    ActiveDocument.FormFields("Adresse").Range.Text = _  
                        CStr(.Cells(lZeile, 3).Value)
                    ActiveDocument.FormFields("PLZ_Ort").Range.Text = _  
                        CStr(.Cells(lZeile, 4).Value)
                    Exit Do
                End If
                lZeile = lZeile + 1
            Loop
        End With
       
        oExcelWorkbook.Close False
        oExcelApp.Quit
    
    Else
        MsgBox "Bitte wŠhlen Sie einen Eintrag aus der Liste aus!", _  
            vbInformation + vbOKOnly, "HINWEIS!"  
        Exit Sub
    End If

  Set oExcelWorkbook = Nothing
  Set oExcelApp = Nothing
  Unload Me
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
  Dim oExcelApp As Object
  Dim oExcelWorkbook As Object
  Dim lZeile As Long
  
    'Zuerst wird die Excel Datei gešffnet  
    Set oExcelApp = CreateObject("Excel.Application")  
    Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
    
    ListBox1.Clear
    lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile †berschriften stehen  
    With oExcelWorkbook.sheets(sTabellenblatt)
        Do While .Cells(lZeile, 1) <> ""  
            ListBox1.AddItem CStr(.Cells(lZeile, 2).Value)
            lZeile = lZeile + 1
        Loop
    End With
       
    oExcelWorkbook.Close False
    oExcelApp.Quit
      
  Set oExcelWorkbook = Nothing
  Set oExcelApp = Nothing
End Sub