ich versuche seit einiger Zeit die folgende Herausforderung zu knacken - kome aber nicht weiter - auch nicht mit Hilfen aus dem Internet.
Es geht mir um folgendes:
In einer Excel-Datei sind in der Zeile 3 verschiedene feste Projektinformationen hinterlegt (die sich von Projekt zu Projekt unterscheiden können)
Ab der Zeile 6 werden mit einer laufenden Nummer weitere Daten für verschiedene Wareneingänge gespeichert.
Die Informationen müssen in eine Word-Vorlage übertragen werden. Um jetzt nicht für jeden einzelnen Wareneingang ein eigenes Word-Dokument zu erzeugen möchte ich gerne eine Art "Serienbrief" erzeugen der mit jedem neuen gewählten Wareneingang an das Word-Dokument die nächste Seite anfügt und mit Daten füllt.
Was bisher geschah:
In der Exceltabelle kann über eine Command-Button ein UserForm geöffnet werden bei dem in die 10 vorhandenen Textfelder die gewünschten laufenden Nummern der Wareneingänge eingetragen werden. Durch einen weiteren Command-Button wird dann der Druck ausgelöst - Das Word Dokument öffnet sich und die erste Seite wird mit den Daten aus dem ersten gewählten Artikel gefüllt.
Hier mal der aktuelle Code des UserForm:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim Pfad As String
Dim appWord As Object
Dim wrdDocument As Object
Dim A1 As String 'Artikel 1
If TextBox1 = "" Then
MsgBox "Bitte gebe eine zu druckende Artikelnummer ein"
Exit Sub
Else: A1 = TextBox1
i = A1 + 5
End If
'i = CB
Pfad = ThisWorkbook.Path & "MeineDatei"
'öffne das Word dokument im Heimordner
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err = 429 Then
Err.Clear
Set appWord = CreateObject("Word.Application")
If Err > 0 Then
MsgBox "Fehler beim Starten von Word!"
Exit Sub
End If
End If
Err.Clear
'Dokument öffnen
'Set wrdDocument = appWord.Documents.Open(Filename:=Pfad)
Set wrdDocument = appWord.Documents.Add(Template:=Pfad)
If wrdDocument = "" Then
MsgBox "Bitte prüfe ob die Word Vorlage "MeineDatei" im gleichen Ordner abgespeichert wurde"
appWord.Quit
Set appWord = Nothing
Exit Sub
End If
On Error GoTo 0
appWord.Visible = True
'Sollte das die Word Vorlage nicht im Heimatordner abgespeichert worden sein gib bei Fehler _
_
_
eine Erinnerung
If Err.Number > 0 Then
MsgBox "Bitte prüfe ob die Word Vorlage "MeineDatei" im gleichen Ordner abgespeichert _
_
_
wurde", vbMsgBoxSetForeground
Exit Sub
End If
On Error GoTo 0
'---Allgemeine Daten
'Projektnummer
Dim PNr As String: PNr = Worksheets("Wareneingang").Range("C3").Value
wrdDocument.Bookmarks("PNr").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText PNr
'Kundenkürzel
Dim KKue As String: KKue = Worksheets("Wareneingang").Range("E3").Value
wrdDocument.Bookmarks("KKue").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText KKue
'Projektmanager
Dim PM As String: PM = Worksheets("Wareneingang").Range("J3").Value
wrdDocument.Bookmarks("PM").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText PM
'Telefon mobil
Dim Telm As String: Telm = Worksheets("Wareneingang").Range("M3").Value
wrdDocument.Bookmarks("Telm").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText Telm
'Telefon Festnetz
Dim TelF As String: TelF = Worksheets("Wareneingang").Range("O3").Value
wrdDocument.Bookmarks("TelF").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText TelF
'--- Artikelspezifische Daten
'- Laufende Nummer
Dim KENr As String: KENr = Worksheets("Wareneingang").Cells(i, 1).Value
wrdDocument.Bookmarks("KENr").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText KENr
'Datum
Dim Datum As String: Datum = Worksheets("Wareneingang").Cells(i, 2).Value
wrdDocument.Bookmarks("Datum").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText Datum
'Anzahl
Dim Stk As String: Stk = Worksheets("Wareneingang").Cells(i, 9).Value
wrdDocument.Bookmarks("Stk").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText Stk
'Bezeichnung
Dim Bez As String: Bez = Worksheets("Wareneingang").Cells(i, 12).Value
wrdDocument.Bookmarks("Bez").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText Bez
'Lieferantennummer
Dim LNr As String: LNr = Worksheets("Wareneingang").Cells(i, 10).Value
wrdDocument.Bookmarks("LNr").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText LNr
'Artikelnummer / Sachnummer
Dim ArtNr As String: ArtNr = Worksheets("Wareneingang").Cells(i, 11).Value
wrdDocument.Bookmarks("ArtNr").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText ArtNr
'Bemerkung
Dim Bem As String: Bem = Worksheets("Wareneingang").Cells(i, 15).Value
wrdDocument.Bookmarks("Bem").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText Bem
End Sub
Hättet ihr eine Idee wie man eine neue Word-Seite mit den gleichen Daten (es liegt eine Tabelle im Formular in der die Daten eingefügt werden) gefüllt werden kann?