Laufzeitfehler 4609
Thomas
ich habe den unten stehenden Code im Internet gefunden und auf meine Mappe angepasst.
Aus einer Exceltabelle werden Spalten nach Word in ein Textfeld übertragen.
Der Code fuktioniert sehr gut, nur wenn ich in der Excelspalte einen langen Text habe bekomme ich den Fehler Laufzeitfehler "4609 zu lange Zeichenfolge"
In dem Worddokument habe ich in den Eigenschaften von Textformularfeld die Zeichenlänge auf unbegrenzt stehen.
Hat jemand einen Tipp für mich?
Vielen Dank im Voraus.
Gruß
Thomas
Private Const Pfad = "H:\Katalog\test.doc" 'an diesem ort liegt das Worddokument,
'die Position des Exceldokumentes ist beliebig
Private wdAnw As Object
Private wdDok As Object
Sub WordMitBestehendemDokumentStarten()
On Error Resume Next
Set wdAnw = GetObject(, "Word.Application") 'Bestehende Word-Instanz suchen
Select Case Err.Number
Case 0 'Alles paletti
Case 429 'Es gibt soweit keine Word-Instanz
Err.Clear
Set wdAnw = CreateObject("Word.Application") 'Word-Instanz erzeugen
If Err.Number > 0 Then
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End If
Case Else 'Unerwarteter Fehler
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End Select
On Error GoTo 0
'
wdAnw.Visible = True 'Instanz sichtbar machen
wdAnw.WindowState = 0
'
'Je nach dem, ob das Dokument bereits geöffnet ist oder nicht wird verbunden
'bzw. geöffnet. Diese Differenzierung geschieht implizit.
On Error Resume Next
Set wdDok = wdAnw.Documents.Open(Filename:=Pfad)
If Err.Number > 0 Then 'Wenn Arbeitsmappe nicht existiert oder unerwarteter Fehler
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End If
On Error GoTo 0
'eigentliche Codeausführung
'jetzt können die Felder im Word gefüllt werden
wdAnw.ActiveDocument.FormFields.Item("Frage1").Result = Sheets("export").Cells(1, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage2").Result = Sheets("export").Cells(2, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage3").Result = Sheets("export").Cells(3, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage4").Result = Sheets("export").Cells(4, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage5").Result = Sheets("export").Cells(5, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage6").Result = Sheets("export").Cells(6, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage7").Result = Sheets("export").Cells(7, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage8").Result = Sheets("export").Cells(8, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage9").Result = Sheets("export").Cells(9, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage10").Result = Sheets("export").Cells(10, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage11").Result = Sheets("export").Cells(11, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage12").Result = Sheets("export").Cells(12, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage13").Result = Sheets("export").Cells(13, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage14").Result = Sheets("export").Cells(14, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage15").Result = Sheets("export").Cells(15, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage16").Result = Sheets("export").Cells(16, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage17").Result = Sheets("export").Cells(17, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage18").Result = Sheets("export").Cells(18, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage19").Result = Sheets("export").Cells(19, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage20").Result = Sheets("export").Cells(20, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage21").Result = Sheets("export").Cells(21, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage22").Result = Sheets("export").Cells(22, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage23").Result = Sheets("export").Cells(23, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage24").Result = Sheets("export").Cells(24, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage25").Result = Sheets("export").Cells(25, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage26").Result = Sheets("export").Cells(26, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage27").Result = Sheets("export").Cells(27, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage28").Result = Sheets("export").Cells(28, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage29").Result = Sheets("export").Cells(29, 1)
wdAnw.ActiveDocument.FormFields.Item("Frage30").Result = Sheets("export").Cells(30, 1)
Sheets("Export").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("Katalog").Select
Range("D7:D9").Select
End Sub
Private Sub BadOrHappyEnd(rc As Long, fehler As String)
If rc > 0 Then
MsgBox fehler, vbExclamation
End If
Set wdDok = Nothing 'Aufräumen
Set wdAnw = Nothing
End Sub