Daten aus Excel in mehrere Word Dokumente nacheinander einfügen

[noseal]

Hallo liebe Community,
ich bin in Sachen VBA leider neu aber würde mir die Arbeit damit gern etwas erleichtern und hoffe ihr könnt mir da ein wenig weiterhelfen.
Worum es geht:
Ich muss auf Arbeit mehrere Word Dokumente immer mit den gleichen Daten füllen (Seriennumern eines Flugzeugs etc).
Nun hätte ich es idealerweise gern so, dass diese Daten in einer Excel Datei stehen und zwar so, dass sich beim öffnen der Excel Liste ein Abfragefenster bekomme um welches Flugzeug es geht und er automatisch diese Daten für dieses Flugzeug ausliest und in die entsprechenden Felder in den Word Dokumenten einträgt- Die Formularfelder habe ich in alle Word Dokumente bereits eingefügt. Falls das Flugzeug noch nicht angelegt ist, soll eine Maske kommen, wo man entsprechende Daten eintragen kann.
Mit einem Button 'Export' sollen dann nacheinander alle Word Dokumente geöffnet werden und mit den Daten des entsprechenden Flugzeugs gefüttert werden. Dabei können die Word Dokumente danach einfach offen bleiben, sodass man diese gegebenfalls ausdrucken oder abspeichern kann.

Um eine kleine Idee davon zu bekommen, habe ich mir bereits schonmal ein Skript zusammengesammelt, welches funktioniert aber zu umständlich ist. Dort muss man jedes mal die Zeile mit den Daten markieren und den Dateiort manuell ändern. Außerdem ist das mit den Masken auch noch nicht realisiert worden.

Sub WordMitBestehendemDokumentStarten2()
 
'um die aktuelle Zeile zu ermitteln
  i = ActiveCell.Row
 
  Pfad = Cells(1, 1) 'entweder in A1 den Pfad eingeben oder diese Zeile auskommentieren...
'  Pfad = "C:\temp\Excel-Word.doc" '...und hier den Pfad eingeben
 
  On Error Resume Next
  Set wdAnw = GetObject(, "Word.Application") 'Bestehende Word-Instanz suchen
  Select Case Err.Number
    Case 0 'Alles paletti
    Case 429 'Es gibt soweit keine Word-Instanz
      Err.Clear
      Set wdAnw = CreateObject("Word.Application") 'Word-Instanz erzeugen
      If Err.Number > 0 Then
        BadOrHappyEnd Err.Number, Err.Description
        Exit Sub
      End If
    Case Else 'Unerwarteter Fehler
      BadOrHappyEnd Err.Number, Err.Description
      Exit Sub
  End Select
  On Error GoTo 0
  '
  wdAnw.Visible = True 'Instanz sichtbar machen
  wdAnw.WindowState = 0
  '
  'Je nach dem, ob das Dokument bereits geöffnet ist oder nicht wird verbunden
  'bzw. geöffnet. Diese Differenzierung geschieht implizit.
  On Error Resume Next
  Set wdDok = wdAnw.Documents.Open(Filename:=Pfad)
  If Err.Number > 0 Then 'Wenn Arbeitsmappe nicht existiert oder unerwarteter Fehler
    BadOrHappyEnd Err.Number, Err.Description
    Exit Sub
  End If
  On Error GoTo 0
 
'hier kommt das eigentliche Eintragen
  wdAnw.ActiveDocument.FormFields.Item("Regist").Result = Cells(i, 1)
  wdAnw.ActiveDocument.FormFields.Item("Modell").Result = Cells(i, 2)
  wdAnw.ActiveDocument.FormFields.Item("MSN").Result = Cells(i, 3)
  wdAnw.ActiveDocument.FormFields.Item("Customer").Result = Cells(i, 4)
  wdAnw.ActiveDocument.FormFields.Item("ESN1").Result = Cells(i, 5)
  wdAnw.ActiveDocument.FormFields.Item("ESN2").Result = Cells(i, 6)
  wdAnw.ActiveDocument.FormFields.Item("MSNAPU").Result = Cells(i, 7)
  wdAnw.ActiveDocument.FormFields.Item("NLG").Result = Cells(i, 8)
  wdAnw.ActiveDocument.FormFields.Item("MLGLH").Result = Cells(i, 9)
  wdAnw.ActiveDocument.FormFields.Item("MLGRH").Result = Cells(i, 10)
 
  BadOrHappyEnd Err.Number, Err.Description
End Sub

Private Sub BadOrHappyEnd(rc As Long, fehler As String)
  If rc > 0 Then
    MsgBox fehler, vbExclamation
  End If
  Set wdDok = Nothing 'Aufräumen
  Set wdAnw = Nothing
End Sub

Ich hoffe ich hab mich einigermaßen verständlich ausgedrückt und könnt mir dabei weiterhelfen.

Vielen Dank im vorau!
Gruß Jacob

 

[noseal]

Bezüglich dem Fenster hab ich jetzt eine Lösung gefunden von Marc Wershofen und würde mich daran halten wollen. Halt nur zusätzlich mit einem Button 'Export' der dann die entsprechende Zeile in die Formularfelder aller Word Dokumente nacheinander einfügt.

Option Explicit
Option Compare Text
' ************************************************************************************************
' Autor und Copyright: Marc Wershoven
' http://www.online-vba.de - E-Mail: info@online-vba.de
' ------------------------------------------------------------------------------------------------
' Wichtige Hinweise:
' - Verwendung der Quelltexte auf eigene Gefahr!
' - Bitte beachten Sie die Nutzungsbedingungen von www.online-vba.de!
' - Dieser Hinweis inkl. Autorennennung darf nicht entfernt werden!
' - Jede Weiterübermittlung, Veröffentlichung oder Verbreitung ist untersagt!
' - Eine kommerzielle/gewerbliche Verwendung ist nicht gestattet!
' ************************************************************************************************
' Diese Hinweise beziehen sich auf den Quelltext, wie dieser unter dem folgenden Link, unverändert
' als Original zu sehen ist und gelten nicht für Veränderungen durch Nutzer bzw. Dritte:
' http://www.online-vba.de/vba_tutorialuserform.php
' ************************************************************************************************

'Neuer Eintrag Schaltfläche Ereignisroutine
Private Sub CommandButton1_Click()
  Dim lZeile As Long
    'Wenn der Benutzer einen neuen Eintrag erzeugen möchten
    'erstellen wir einen neuen Eintrag in der ListBox und markieren
    'diesen, damit der Benutzer die Daten eintragen kann
   
    lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriftrn
    'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
        lZeile = lZeile + 1 'Nächste Zeile bearbeiten
    Loop
   
    'Nach Durchlauf dieser Schleife steht lZeile in der ersten leeren Zeile von Tabelle1
    'Neuen Eintrag in die Tabelle1 schreiben, Spalte ID muss gefüllt sein, damit
    'unsere Routinen die Zeile wiederfinden!
    Tabelle1.Cells(lZeile, 1) = CStr("Neuer Eintrag Zeile " & lZeile)
   
    'Und neuen Eintrag in die UserForm eintragen
    ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile)
   
    'Den neuen Eintrag markieren mit Hilfe des ListIndexes
    ListBox1.ListIndex = ListBox1.ListCount - 1
    'Durch das Click Ereignis der ListBox werden die Daten automatisch geladen
   
End Sub

'Löschen Schaltfläche Ereignisroutine
Private Sub CommandButton2_Click()
  Dim lZeile As Long
 
    'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
    If ListBox1.ListIndex = -1 Then Exit Sub
 
    'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
    lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriftrn
    'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
   
        'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
        If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
           
            'Eintrag gefunden, die ganze Zeile wird nun gelöscht
            Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete
           
            'Die ListBox muss nun neu geladen werden!
            Call UserForm_Initialize
            If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
           
            Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
        End If
   
        lZeile = lZeile + 1 'Nächste Zeile bearbeiten
    Loop
   
End Sub

'Speichern Schaltfläche Ereignisroutine
Private Sub CommandButton3_Click()
  Dim lZeile As Long
 
    'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
    If ListBox1.ListIndex = -1 Then Exit Sub
   
    'Wir müssen prüfen, ob die ID Spalte auch gefüllt ist!!
    If Trim(CStr(TextBox1.Text)) = "" Then
        'Meldung ausgeben
        MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
        'Abbrechen des Speicherroutine
        Exit Sub
    End If
    'Ausbauoption: Prüfen ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
   
    'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
    lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriftrn
    'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
   
        'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
        If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
           
            'Eintrag gefunden, TextBoxen in die Zellen schreiben
            Tabelle1.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
            Tabelle1.Cells(lZeile, 2).Value = TextBox2.Text
            Tabelle1.Cells(lZeile, 3).Value = TextBox3.Text
            Tabelle1.Cells(lZeile, 4).Value = TextBox4.Text
            Tabelle1.Cells(lZeile, 5).Value = TextBox5.Text
            Tabelle1.Cells(lZeile, 6).Value = TextBox6.Text
           
            'Die ListBox muss nun neu geladen werden
            'allerdings nur wenn sich der Name (ID) geändert hat
            If ListBox1.Text <> Trim(CStr(TextBox1.Text)) Then
                Call UserForm_Initialize
                If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
            End If
           
            Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
        End If
   
        lZeile = lZeile + 1 'Nächste Zeile bearbeiten
    Loop
   
End Sub

'Beenden Schaltfläche Ereignisroutine
Private Sub CommandButton4_Click()
    Unload Me
End Sub

Private Sub CommandButton5_Click()

End Sub

Private Sub Label2_Click()

End Sub

'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
  Dim lZeile As Long
    'Wenn der Benutzer einen Namen anklickt, suchen wir
    'diesen in der Tabelle1 heraus und tragen die Daten
    'in die TextBoxen ein.
   
    'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TextBox4 = ""
    TextBox5 = ""
    TextBox6 = ""
   
    'Nur wenn ein Eintrag selektiert/markiert ist
    If ListBox1.ListIndex >= 0 Then
   
        lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriftrn
        'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
        Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
       
            'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 1
            'gefunden haben, übertragen wir die anderen Spalteninhalte
            'in die TextBoxen!
            If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
           
                'TextBoxen füllen
                TextBox1 = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value))
                TextBox2 = Tabelle1.Cells(lZeile, 2).Value
                TextBox3 = Tabelle1.Cells(lZeile, 3).Value
                TextBox4 = Tabelle1.Cells(lZeile, 4).Value
                TextBox5 = Tabelle1.Cells(lZeile, 5).Value
                TextBox6 = Tabelle1.Cells(lZeile, 6).Value
           
                Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
            End If
       
            lZeile = lZeile + 1 'Nächste Zeile bearbeiten
       
        Loop
       
    End If
   
End Sub

Private Sub UserForm_Activate()
    'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen
    'jedoch nur wenn auch Einträge in der Liste stehen
    If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub

'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
  Dim lZeile As Long
 
    'Alle TextBoxen leer machen
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TextBox4 = ""
    TextBox5 = ""
    TextBox6 = ""
 
    'In dieser Routine laden wir alle vorhandenen
    'Einträge in die ListBox1
    ListBox1.Clear 'Zuerst einmal die Liste leeren
   
    lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriftrn
    'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
       
        'Aktuelle Zeile in die ListBox eintragen
        ListBox1.AddItem Trim(CStr(Tabelle1.Cells(lZeile, 1).Value))
       
        lZeile = lZeile + 1 'Nächste Zeile bearbeiten
       
    Loop
   
End Sub