Laufzeitfehler 424 Excel -> Word
28.05.2018 15:36:14
Peter
Dank der Hilfe des Forums bei diesem Beitrag https://www.herber.de/forum/archiv/1612to1616/t1613349.htm
konnte ich die damalige, einfache Aufgabe lösen. Mittlerweile sind allerdings grosse Textmengen hinzugekommen. In einigen Zellen befindet sich mehr als 300 Zeichen Text, welche der Textmarke der Word-Vorlage zugewiesen werden sollen. Wenn ich das Makro mit dem Debugging starte, bleibt er mir bei der fett markierten Stelle stehen (erste Zeile mit Laufnummer) und gibt den Laufzeitfehler 424 "Objekt erforderlich" aus.
Im Vergleich zum ursprünglichen Makro habe ich nur "result.text" geändert, damit die grossen Textmengen übergeben werden können.
Was habe ich falsch gemacht?
Vielen Dank für eine evt. Hilfe
Peter
Sub Uebergabe_Testfaelle()
Dim wrdApp As Object
Dim wrdDoc As Object
Dim Pfad As String
Dim Zeile As Long
Dim wks As Worksheet
Pfad = "\\tobler.local\dfsroot\Home$\AAH3609\Documents\Testfaelle\Testfallvorlage.dotm"
Set wks = Sheets("Prozessuebersicht")
' On Error GoTo ErrorExit
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
With wks
'von Zeile 5 bis letzte Zeile mit Inhalt in Spalte B
For Zeile = 5 To .Cells(.Rows.Count, 2).End(xlUp).Row 'oder fester Wert für letzte _
Zeile
Set wrdDoc = wrdApp.Documents.Add(Pfad)
wrdDoc.FormFields("Laufnummer").Result.Text = .Cells(Zeile, 2).Value 'anpassen _
_
b>
wrdDoc.FormFields("Vorgang").Result.Text = .Cells(Zeile, 3).Value 'anpassen
wrdDoc.FormFields("Beschreibung").Result.Text = .Cells(Zeile, 4).Value 'anpassen
wrdDoc.FormFields("Vorgaben").Result.Text = .Cells(Zeile, 5).Value 'anpassen
wrdDoc.FormFields("Informationen").Result.Text = .Cells(Zeile, 6).Value 'anpassen
wrdDoc.FormFields("Testfallnummer").Result.Text = .Cells(Zeile, 7).Value 'anpassen
wrdDoc.FormFields("Testresultat").Result.Text = .Cells(Zeile, 8).Value 'anpassen
wrdDoc.SaveAs ThisWorkbook.Path & "\Testfaelle" & .Cells(Zeile, 7).Text & ".docx"
wrdDoc.Close
Next
End With
wrdApp.Quit
Set wks = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub