Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Laufzeitfehler 4609 | Herbers Excel-Forum


Betrifft: Laufzeitfehler 4609 von: Thomas
Geschrieben am: 06.02.2012 11:28:15

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

  

Betrifft: WORD : Excel Zellwert in Formular-Textbox einfügen von: NoNet
Geschrieben am: 06.02.2012 15:40:14

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

Code eingefügt mit Syntaxhighlighter 4.15


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


  

Betrifft: AW: WORD : Excel Zellwert in Formular-Textbox einfügen von: Thomas
Geschrieben am: 06.02.2012 16:19:00

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


  

Betrifft: AW: WORD : Excel Zellwert in Formular-Textbox einfügen von: Thomas
Geschrieben am: 09.02.2012 06:43:11

Hallo,

habe es gelöst bekommen.

Gruß
Thomas


  

Betrifft: AW: WORD : Excel Zellwert in Formular-Textbox einfügen von: Thomas
Geschrieben am: 09.02.2012 06:43:38

gelöst


Beiträge aus den Excel-Beispielen zum Thema "Laufzeitfehler 4609"