for Schleife in Word
29.12.2021 02:41:08
Tom
Ich bin auf der Suche nach einer Möglichkeit, eine "for Schleife" in einem Makro für ein Word Dokument einzubauen. Für jede Zeile in der Tabelle soll ein Eintrag auf der zweiten Seite der Vorlagendatei erstellt werden. Bis und mit der ersten Zeile bin ich gekommen, für das Erstellen der weiteren Zeilenreichen meine VBA Kenntnisse leider nicht aus. Ich bin der Meinung, dass dies mit einer VBA Schleife möglich sein sollte.
Die Einträge sollten auch entsprechend Formatiert sein --> 1.0 = Überschrift 1, 1.1 = Überschrift 2
Im Anhang sende ich die Word Vorlage und die Excel Arbeitsmappe mit dem Makro. Der Code schaut wie folgt aus:
Arbeitsmappe --> https://www.herber.de/bbs/user/150047.xlsm
Word Vorlage --> https://www.herber.de/bbs/user/150048.doc (erstelle aus diesem Dokument eine .dotx Datei)
Vielen DANK für eure Hilfe!
Sub Traktandenliste_erstellen()
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim varAdd As String
Dim pathsave As String
Dim pathtrlist As String
Dim nummer As String
Dim datum As String
Dim zeit_von As String
Dim zeit_bis As String
Dim ort As String
Dim anlass As String
wdApp.Visible = True
Zeilen_Zahl = Cells(Rows.Count, "b").End(xlUp).Row
varAdd = Tabelle1.Cells(2, 1).Value
'Pfad zur Vorlagendatei
pathtrlist = Range("P4")
'Pfad zum Speichern
pathsave = Range("P2") & ("Sitzung ") & varAdd & ("\")
'Tabellenbereich aufsteigend sortieren
Tabelle1.Range("A2:H" & Zeilen_Zahl).Sort Key1:=Range("B1:B" & Zeilen_Zahl), Order1:=xlAscending, Header:=xlYes
wdApp.Documents.Add pathtrlist
Sheets("Tabelle1").Activate
nummer = Cells(2, 1)
datum = Cells(2, 4)
zeit_von = Cells(2, 5)
zeit_bis = Cells(2, 6)
ort = Cells(2, 7)
tr1 = Cells(2, 3)
ref1 = Cells(2, 8)
zeit_von1 = Cells(2, 5)
'fügt die Werte bis und mit Traktandum 1 ein:
wdApp.ActiveDocument.Bookmarks("Nummer").Range.Text = nummer
wdApp.ActiveDocument.Bookmarks("Nummer1").Range.Text = nummer
wdApp.ActiveDocument.Bookmarks("Nummer2").Range.Text = nummer
wdApp.ActiveDocument.Bookmarks("datum").Range.Text = datum & vbNewLine
wdApp.ActiveDocument.Bookmarks("zeit_von").Range.Text = zeit_von
wdApp.ActiveDocument.Bookmarks("zeit_bis").Range.Text = zeit_bis & vbNewLine
wdApp.ActiveDocument.Bookmarks("ort").Range.Text = ort & vbNewLine
wdApp.ActiveDocument.Bookmarks("Traktandum1").Range.Text = tr1
wdApp.ActiveDocument.Bookmarks("Referent1").Range.Text = ref1
wdApp.ActiveDocument.Bookmarks("Zeit_von1").Range.Text = zeit_von1 & " Uhr" & vbNewLine
'Dokument speichern und schliessen
wdApp.ActiveDocument.SaveAs2 Filename:=pathsave & "Sitzung " & varAdd & ".docx", _
FileFormat:=wdFormatXMLDocument
wdApp.Quit
End Sub