Makro mit Schleife für nächste Zeile
30.04.2020 11:18:05
Julian
als Makro-Anfänger habe ich für eine automatisierte Anschreibenserstellung ein Makro geschrieben, dass eine Vorlage öffnet und bei gesetzten Bookmarks vorgefertigte Bilddateien einsetzt und das Dokument dann als .docx und als .pdf speichert.
Da das selbe Makro für mehrere Anschreiben verwendet werden soll, werden sowohl unterschiedliche Vorlagen, als auch unterschiedliche Bilddateien gezogen, die über den Dateipfad und das Worksheet mit Textkette in einer Zelle zusammengesetzt werden und dann durch das Makro mit range als feste Zellbezüge abgerufen werden.
Jetzt suche ich nach einer Möglichkeit, mit einer Schleife das Makro wiederholt für die nächste Zeile des Worksheets ablaufen zu lassen und anstelle der vier festen Zellbezüge (A8,H8,I8,I8) eine dynamische Ansprache der Zellwerte für jede folgende Zeile bis zur letzten gefüllten Zeile der Spalte A zu erreichen.
Bislang konnte ich keine Oline-Lösung für eine Schleife finden, die die festen Range Werte in mehreren Spalten jeweils für die nächste Zeile um +1 anpasst. Welche Schleife wäre am geeignetsten?
Wie könnte ich das Problem lösen? Vielen Dank schon einmal Voraus.
Sub Anschreiben()
Dim oWordApp As Object
Dim oWordDoc As Object
Dim oWord As Object
Dim FlName As String
Dim imagePath As String
Dim pathTemplate As String
Dim pathimageAnrede As String
Dim pathimageSignature As String
Dim pathdocx As String
Dim pathpdf As String
Dim filenametemplate As String
Dim filenameimageAnrede As String
Dim filenameimagesignatureRS As String
Dim filenameimagesignatureSM As String
Dim filenamesave As String
'Establish a Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")
oWordApp.Visible = True
If Err.Number 0 Then
Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
oWordApp.Visible = False
'Open Report Template
'Change filenametemplate = Range("H...").Text to applied workbook line.
With oWordDoc
pathTemplate = "C:\Users\...\"
filenametemplate = Range("H8").Text
Set oWordDoc = oWordApp.Documents.Open(pathTemplate & filenametemplate & ".docx")
'Change filenameimageAnrede = Range("A...").Text to applied workbook line.
pathimageAnrede = "C:\Users\...\"
filenameimageAnrede = Range("A8").Text
pathimageSignature = "C:\Users\...\"
filenameimagesignatureRS = Range("N3").Text
pathimageSignature = "C:\Users\...\"
filenameimagesignatureSM = Range("N4").Text
'Insert Images at manually added Bookmarks
imagePath = pathimageAnrede & filenameimageAnrede & ".jpg"
imagePath = "C:\Users\...jpg"
imagePath = "C:\Users\...jpg"
FlName = pathTemplate & filenametemplate & ".docx"
oWordDoc.Bookmarks("Anrede").Range.InlineShapes.AddPicture Filename:=pathimageAnrede & _
filenameimageAnrede & ".jpg"
oWordDoc.Bookmarks("SignaturRS").Range.InlineShapes.AddPicture Filename:=pathimageSignature _
_
& filenameimagesignatureRS & ".jpg"
oWordDoc.Bookmarks("SignaturSM").Range.InlineShapes.AddPicture Filename:=pathimageSignature _
_
& filenameimagesignatureSM & ".jpg"
End With
'Save as DOC
'Change filenamesave = Range("I...").Text to applied workbook line.
With oWordApp
pathdocx = "C:\Users\...\"
filenamesave = Range("I8").Text
Application.DisplayAlerts = False
oWordApp.ActiveDocument.SaveAs Filename:=pathdocx & filenamesave & ".docx"
oWordApp.Application.DisplayAlerts = True
End With
'Save as PDF
'Change filenamesave = Range("I...").Text to applied workbook line.
With oWordDoc
pathpdf = "C:\Users\..."
filenamesave = Range("I8").Text
Application.DisplayAlerts = False
oWordDoc.ExportAsFixedFormat OutputFilename:=pathpdf & filenamesave & ".pdf", ExportFormat:= _
_
wdExportFormatPDF
oWordDoc.Application.DisplayAlerts = True
End With
With oWordApp
oWordApp.ActiveDocument.Close
End With
End Sub