Mein aktueller Code sieht wie folgt aus, wobei er noch aus irgendeinem Grund nicht funktioniert. Hat wer eine Idee?
Sub zwanzigsterzehnter()
Dim wd As Object
Dim wdDOC As Object
Dim iRow As Long
Dim PercentageScore As Variant
Dim sh As Worksheet
Dim myValue As Variant
Dim WorkOrder As String
Dim wdgotobookmark As Object
'aus Excel Sheet „Overview“ ab Feld B8
WorkOrder = Worksheets("Overview").Range("B8").Value
'ab Spalte 8
Set sh = ThisWorkbook.Sheets("Overview")
iRow = 8 'row in which data starts from in database
Do While sh.Range("A" & iRow).Value <> "" 'alle Zeilen die nicht leer sind und Zelle A gleich Wert in D1 entspricht
If WorkOrder = sh.Range("D1" & iRow).Value Then
'Word Vorlage öffnen
Set wdDOC = wd.Documents.Add("C:\Pfad\Vorlage.docx")
‚Word sichtbar lassen
wd.Visible = True
'Textmarken in Word einfügen
wd.Selection.GoTo what:=wdgotobookmark, NAME:="DN"
wd.Selection.TypeText Text:=sh.Range("B" & iRow).Value
wd.Selection.GoTo what:=wdgotobookmark, NAME:="DNa"
wd.Selection.TypeText Text:=sh.Range("C" & iRow).Value
'Word mit neuem Namen aus Zeile B1 speichern
ActiveDocument.SaveAs2 (ThisWorkbook.Path & "C:\Pfad\" & sh.Range("B1" & iRow).Value & ".docx")
Exit Do
End If
iRow = iRow + 1
Loop
MsgBox ("Word Vorlage erstellt")
End Sub
|