Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1248to1252
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Laufzeitfehler 4609

Laufzeitfehler 4609
Thomas
Hallo zusammen,
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
WORD : Excel Zellwert in Formular-Textbox einfügen
06.02.2012 15:40:14
NoNet
Hallo Thomas,
hier zunächst einmal eine Verkürzung Deines Codes :
VBA-Code:
Private Const Pfad = "H:\Katalog\test.doc" 'an diesem ort liegt das Worddokument,
'Private Const Pfad = "c:\Temp\Frage-Formular.doc" 'an diesem ort liegt das Worddokument,
'die Position des Exceldokumentes ist beliebig
Private wdAnw As Object
Private wdDok As Object
Sub WordMitBestehendemDokumentStarten()
    Dim wdAnw As Object, wdDok As Object, lngF As Long
    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
    With Sheets("Export")
        For lngF = 1 To 30 'Felder 1 bis 30 befüllen
            wdAnw.ActiveDocument.FormFields.Item("Frage" & lngF).Result = .Cells(lngF, 1)
        Next
        .Cells.ClearContents
        .Range("A1").Select
    End With
    Sheets("Katalog").Activate
    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
zu Deinem Problem : Aus Excel heraus kann man max. 255 Zeichen per Office-Zwischenablage kopieren - bei längeren Texten erscheint diese Fehlermeldung.
Alternative : Text in Zwischenablage kopieren und in WORD einfügen (Aufruf : TestTextInZwischenablage(Cells(lngF,1)) ):
Sub VerweisAufMSForms20DLL()
Dim objRef As Object, strDLL As String, lngR As Long
Dim bolRefGefunden As Boolean
strDLL = Environ("windir") & "\FM20.DLL" 'Name der 'MS Forms 2.0 Object Library'
For lngR = 1 To Application.VBE.ActiveVBProject.References.Count
If UCase(Application.VBE.ActiveVBProject.References(lngR).FullPath) = UCase(strDLL) _
Or Application.VBE.ActiveVBProject.References(lngR).GUID = _
"{0D452EE1-E08F-101A-852E-02608C4D0BB4}" Then
bolRefGefunden = True
lngR = Application.VBE.ActiveVBProject.References.Count 'Schleifenende
End If
Next
If Not bolRefGefunden Then
Application.VBE.ActiveVBProject.References.AddFromFile strDLL
End If
End Sub
Sub TestTextInZwischenablage(rngZ)
'Verweis auf  'Microsoft Forms 2.0 Object Library' erforderlich !
Dim objData As New DataObject
VerweisAufMSForms20DLL  'Setzt den Verweis auf die DLL
'Zellinhalt in Zwischenablage kopieren :
objData.SetText rngZ.Text
objData.PutInClipboard
End Sub
Der entscheidende Teil (in WORD VBA) zum Einfügen des Textes in das Formfield fehlt mir leider auch... :-(
Gruß, NoNet
AW: WORD : Excel Zellwert in Formular-Textbox einfügen
Thomas

Hallo,
danke für die Verkürzung.
Gibt es noch eine andere Alternative von Excel nach Word zu kopieren?
So dass mehr als 255 Zeichen möglich sind.
Gruß
Thomas
AW: WORD : Excel Zellwert in Formular-Textbox einfügen
Thomas

Hallo,
habe es gelöst bekommen.
Gruß
Thomas
AW: WORD : Excel Zellwert in Formular-Textbox einfügen
Thomas

gelöst
Anzeige
AW: WORD : Excel Zellwert in Formular-Textbox einfügen
06.02.2012 16:19:00
Thomas
Hallo,
danke für die Verkürzung.
Gibt es noch eine andere Alternative von Excel nach Word zu kopieren?
So dass mehr als 255 Zeichen möglich sind.
Gruß
Thomas
AW: WORD : Excel Zellwert in Formular-Textbox einfügen
09.02.2012 06:43:11
Thomas
Hallo,
habe es gelöst bekommen.
Gruß
Thomas
AW: WORD : Excel Zellwert in Formular-Textbox einfügen
09.02.2012 06:43:38
Thomas
gelöst

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige