Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1592to1596
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

Text von Excel an Word Textmarken übergeben

Text von Excel an Word Textmarken übergeben
21.11.2017 16:34:43
Excel
Hallo zusammen,
ich lese schon seit geraumer Zeit die Beiträge in diesem Forum, da ich hier fast zu jedem Problem bislang eine Lösung gefunden habe. Leider komme ich im Moment absolut nicht weiter. Ich möchte mit meinem Makro den Text aus verschiedenen Textfelder an Textmarken in einem Word-Dokument übergeben. Ich muss zugeben, dass ich den Code größtenteils aus dem Internet habe (kann ehrlich nicht mehr sagen, woher)....
Wenn ich den Code so wie unten dargestellt ausführe, kommt die Fehlermeldung "Objekt erforderlich". Teilweise kommt zusätzlich beim Versuch die nun geöffnete Vorlage zu schließen noch die Abfrage, ob die Normal.dotm gespeicher werden soll. Ich weiß wirklich nicht mehr weiter...
Hier der Code:

Sub Kundenanschreiben2()
Dim appWord As Object
Dim docWord As Object
Dim xWordLiefNicht As Boolean
Dim iRow As Long
Dim Marke As String
Dim strBookmark As String
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
On Error GoTo errorMsgWord
Err.Clear
'Verhindern, dass eine zweite Instanz von Word gestartet wird
If appWord Is Nothing Then
Set appWord = CreateObject("Word.Application")
xWordLiefNicht = True
End If
Set docWord = appWord.Documents.Add(ThisWorkbook.Path & "\Vorlagen\Vorlage_Kundenanschreiben. _
dotx")
appWord.Visible = True
iRow = 2
Do Until IsEmpty(ThisWorkbook.Sheets(2).Cells(iRow, 1))
strBookmark = ThisWorkbook.Sheets(2).Cells(iRow, 2)
If Not docWord.Bookmarks.Exists(strBookmark) Then
iRow = iRow + 1
Else
If Spalte_Aktionsdatenbank.Value = 10 Then
Marke = ThisWorkbook.Sheets(1).Cells(Zeile_Aktionsdatenbank, Spalte_Aktionsdatenbank) _
_
Marke = Mid(Marke, 5)
docWord.Bookmarks(strBookmark).Range = Marke
Else
Spalte_Aktionsdatenbank = ThisWorkbook.Sheets(2).Cells(iRow, 4).Value
docWord.Bookmarks(strBookmark).Range = ThisWorkbook.Sheets(1).Cells( _
Zeile_Aktionsdatenbank, Spalte_Aktionsdatenbank)
iRow = iRow + 1
End If
End If
Loop
'speichern
docWord.SaveAs Filename:=ThisWorkbook.Path & "\test.docx"
'schließen
docWord.Close
Set docWord = Nothing
If xWordLiefNicht Then
appWord.Quit
End If
Set appWord = Nothing
Exit Sub
errorMsgWord:
MsgBox Err.Description, 16, "Error"
Set docWord = Nothing
Set appWord = Nothing
End Sub
Ich wäre euch sehr dankbar, wenn ihr mir weiterhelfen könntet. Vielen Dank schon einmal.
Gruß
Jan

20
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Text von Excel an Word Textmarken übergeben
21.11.2017 17:21:44
Excel
Eine Fehlermeldung (ohne Angabe der Zeile, in der sie auftaucht) bringt alleine nix.
AW: Text von Excel an Word Textmarken übergeben
21.11.2017 17:56:33
Excel
Ich würde ja gerne, aber leider komme ich nicht so weit. Wenn ich den Errorhandler ausschalte, dann beokomme ich keine Meldung und Excel hängt sich auf.
AW: Text von Excel an Word Textmarken übergeben
21.11.2017 17:58:26
Excel
Kannst du mal beide posten?
AW: Text von Excel an Word Textmarken übergeben
21.11.2017 19:13:30
Excel
Hallo Jan,
einmal benutzt du hier:
If Spalte_Aktionsdatenbank.Value = 10 Then
die Variable Spalte_Aktionsdatenbank als Objekt, und einmal hier:
Marke = ThisWorkbook.Sheets(1).Cells(Zeile_Aktionsdatenbank, Spalte_Aktionsdatenbank)
die selbe Variable als Nummer. Für irgendwas musst du dich entscheiden, denn beides zusammen geht nicht.
Aus der Fehlermeldung geht für mich hervor, dass es die Verwendung als Objekt ist.
Gruß
Nepumuk
Anzeige
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 15:00:41
Excel
Hallo, ich habe den Code etwas abgeändert. Jetzt hat es kurzzeitig funktioniert und nun kommt bei jeder Ausführung folgender Fehler:
Laufzeitfehler 429: Objekterstellung durch ActiveX-Komponente nicht möglich
Hier der aktuelle Code:
Sub Kundenanschreiben2()
Dim appWord As Object
Dim docWord As Object
Dim xWordLiefNicht As Boolean
Dim iRow As Long
Dim Marke As String
Dim strBookmark As String
Dim Spalte_Aktionsdatenbank As Long
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
On Error GoTo errorMsgWord
Err.Clear
If appWord Is Nothing Then
'damit wird verhindert das Word ein zweites Mal
'mit CreateObject geöffnet wird
'die erstere läst sich sonst aus dem Task nicht entfernen
'Bei mehreren Versuchen erreichst du ganz schnell ein OutOfMemory
Set appWord = CreateObject("Word.Application")
xWordLiefNicht = True
End If
Set docWord = appWord.Documents.Add(ThisWorkbook.Path & "\Vorlagen\Vorlage_Kundenanschreiben. _
dotx")
appWord.Visible = True
iRow = 2
Do Until IsEmpty(ThisWorkbook.Worksheets("Textmarker").Cells(iRow, 1))
strBookmark = ThisWorkbook.Worksheets("Textmarker").Cells(iRow, 2)
Spalte_Aktionsdatenbank = ThisWorkbook.Worksheets("Textmarker").Cells(iRow, 4).Value
If Not docWord.Bookmarks.Exists(strBookmark) Then
Debug.Print strBookmark & " existiert nicht"
Else
If Spalte_Aktionsdatenbank = 10 Then
Debug.Print strBookmark & " wird hinzugefügt"
Marke = ThisWorkbook.Worksheets("Aktionsdatenbank").Cells(Zeile_Aktionsdatenbank,  _
Spalte_Aktionsdatenbank).Value
Marke = Mid(Marke, 5)
docWord.Bookmarks(strBookmark).Range = Marke
Debug.Print strBookmark & " wird hinzugefügt"
Else
Debug.Print strBookmark & " wird hinzugefügt"
docWord.Bookmarks(strBookmark).Range = ThisWorkbook.Worksheets("Aktionsdatenbank"). _
Cells(Zeile_Aktionsdatenbank, Spalte_Aktionsdatenbank).Text
End If
End If
iRow = iRow + 1
Loop
'speichern
docWord.SaveAs Filename:=ThisWorkbook.Path & "\test.docx"
'schließen
docWord.Close
Set docWord = Nothing
If xWordLiefNicht Then
appWord.Quit
End If
Set appWord = Nothing
Exit Sub
errorMsgWord:
MsgBox Err.Number & " " & Err.Description
Set docWord = Nothing
Set appWord = Nothing
End Sub

Anzeige
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 15:21:27
Excel
Hallo Jan,
darf ich mir die Zeile aussuchen welche den Fehler auslöst oder verrätst du sie mir?
Gruß
Nepumuk
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 17:10:27
Excel
Sorry :-/
Set appWord = GetObject(, "Word.Application")
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 17:34:45
Excel
Hallo Jan,
kann ich nicht nachvollziehen. Da ist doch extra eine On Error Resume Next Anweisung vorgeschaltet.
Dazu fällt mir leider nichts ein.
Gruß
Nepumuk
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 17:49:09
Excel
Ich hatte folgendes aktiviert: Unterbrechen bei jedem Fehler
Ich hab jetzt "bei nicht verarbeiteten Fehlern" aktviert und nun kommt bei der Ausührung folgender Fehler:
1004: Anwendungs- oder objektdefinierter Fehler
Wenn ich nun die Prozedur Schritt für Schritt durchlaufe, kommt der Fehler bei folgender Zeile:
MsgBox Err.Number & " " & Err.Description
Ich bin ratlos...
Anzeige
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 17:38:20
Excel
Hast du Fehlerbehandlung (VBA-Editor/Extras/Optionen/Allgemein/Unterbrechen bei NICHT verarbeiteten Fehlern) aktiviert?
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 17:56:12
Excel
Update:
Wenn ich den Errohandler deaktviere...
'On Error GoTo errorMsgWord
'    Err.Clear

... dann funktioniert auf einmal alles.
Wieso produziert die Prozedur denn Fehler 1004, wenn die oben genannten Zeilen aktiviert sind?
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 17:59:31
Excel
"1004: Anwendungs- oder objektdefinierter Fehler" - Ist das eine Fehlermeldung oder nur deine MSGBOX?
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 18:01:50
Excel
Das ist nur eine Messagebox.
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 18:02:03
Excel
"1004: Anwendungs- oder objektdefinierter Fehler" - Ist das eine Fehlermeldung oder nur deine MSGBOX?
Deaktiviere mal BEIDE (wieso 2?) Errorhandler und schau mal, wo genau der Fehler auftasucht.
Anzeige
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 18:06:28
Excel
Ich habe das Gefühl, wir "schreiben" aneinander vorbei :-) Habe es deaktiviert und so funktioniert alles. Wieso funktioniert es nicht, wenn ich den Errorhandler aktiviere? Wieso produziert dieser einen Fehler, der sonst nicht da ist?
Also so ist der aktuelle Stand:
Sub Kundenanschreiben()
Dim appWord As Object
Dim docWord As Object
Dim xWordLiefNicht As Boolean
Dim strAktionsnummer As String
Dim strAktionsbeschreibung As String
Dim strBookmark_Aktionsnummer As String
Dim strBookmark_Aktionsbeschreibung As String
strAktionsnummer = Form_Eingabemaske.textbox_aktionsnummer.Value
strAktionsbeschreibung = Form_Eingabemaske.textbox_aktionsbeschreibung.Value
strBookmark_Aktionsnummer = "Aktionsnummer1"
strBookmark_Aktionsbeschreibung = "Aktionsbeschreibung"
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
'On Error GoTo errorMsgWord
'   Err.Clear
If appWord Is Nothing Then
'damit wird verhindert das Word ein zweites Mal
'mit CreateObject geöffnet wird
'die erstere läst sich sonst aus dem Task nicht entfernen
'Bei mehreren Versuchen erreichst du ganz schnell ein OutOfMemory
Set appWord = CreateObject("Word.Application")
xWordLiefNicht = True
End If
'Set appWord = CreateObject("Word.Application")
Set docWord = appWord.Documents.Add(ThisWorkbook.Path & "\Vorlagen\Vorlage_Kundenanschreiben. _
dotx")
appWord.Visible = True
If Not docWord.Bookmarks.Exists(strBookmark_Aktionsnummer) Then
MsgBox "Textmarke -Aktionsnummer_oben_rechts- nicht vorhanden"
Exit Sub
Else
docWord.Bookmarks(strBookmark_Aktionsnummer).Range = strAktionsnummer
docWord.Bookmarks(strBookmark_Aktionsbeschreibung).Range = strAktionsbeschreibung
End If
'speichern
docWord.SaveAs Filename:=ThisWorkbook.Path & "\test.docx"
'schließen
docWord.Close 'wichtig
Set docWord = Nothing
If xWordLiefNicht Then
appWord.Quit  'wichtig
End If
Set appWord = Nothing
Exit Sub
'errorMsgWord:
'  MsgBox Err.Description, 16, "Error"
'   Set docWord = Nothing
'   Set appWord = Nothing
End Sub

Anzeige
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 18:09:22
Excel
Du redest an mir vorbei (bzw liest nicht richtig, was ich schrieb).
Weil du immer noch einen Errorhandler aktiv hast, und zwar:
On Error Resume Next

Und das reicht völlig.
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 18:26:54
Excel
Ok...
By the way merke ich gerade, dass ich in der letzten Nachricht nicht den korrekten Code gepostet habe. Hier nochmal korrekt:
Sub Kundenanschreiben2()
Dim appWord As Object
Dim docWord As Object
Dim xWordLiefNicht As Boolean
Dim iRow As Long
Dim Marke As String
Dim strBookmark As String
Dim Spalte_Aktionsdatenbank As Long
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
'On Error GoTo errorMsgWord
'    Err.Clear
If appWord Is Nothing Then
'damit wird verhindert das Word ein zweites Mal
'mit CreateObject geöffnet wird
'die erstere läst sich sonst aus dem Task nicht entfernen
'Bei mehreren Versuchen erreichst du ganz schnell ein OutOfMemory
Set appWord = CreateObject("Word.Application")
xWordLiefNicht = True
End If
Set docWord = appWord.Documents.Add(ThisWorkbook.Path & "\Vorlagen\Vorlage_Kundenanschreiben. _
dotx")
appWord.Visible = True
iRow = 2
Do Until IsEmpty(ThisWorkbook.Worksheets("Textmarker").Cells(iRow, 1))
strBookmark = ThisWorkbook.Worksheets("Textmarker").Cells(iRow, 2)
Spalte_Aktionsdatenbank = ThisWorkbook.Worksheets("Textmarker").Cells(iRow, 4).Value
If Not docWord.Bookmarks.Exists(strBookmark) Then
Debug.Print strBookmark & " existiert nicht"
Else
If Spalte_Aktionsdatenbank = 10 Then
Debug.Print strBookmark & " wird hinzugefügt"
Marke = ThisWorkbook.Worksheets("Aktionsdatenbank").Cells(Zeile_Aktionsdatenbank,  _
Spalte_Aktionsdatenbank).Value
Marke = Mid(Marke, 5)
docWord.Bookmarks(strBookmark).Range = Marke
Debug.Print strBookmark & " wird hinzugefügt"
Else
Debug.Print strBookmark & " wird hinzugefügt"
docWord.Bookmarks(strBookmark).Range = ThisWorkbook.Worksheets("Aktionsdatenbank"). _
Cells(Zeile_Aktionsdatenbank, Spalte_Aktionsdatenbank).Text
End If
End If
iRow = iRow + 1
Loop
'speichern
docWord.SaveAs Filename:=ThisWorkbook.Path & "\test.docx"
'schließen
docWord.Close
Set docWord = Nothing
If xWordLiefNicht Then
appWord.Quit
End If
Set appWord = Nothing
Exit Sub
errorMsgWord:
MsgBox Err.Number & " " & Err.Description
Set docWord = Nothing
Set appWord = Nothing
End Sub
Also so wie ist, funktioniert ist. Ich verstehe den Code aber noch nicht...
Ich möchte verhindern, dass eine zweite Instanz von Word geöffnet wird, wenn es bereits läuft.
Wenn ich das richtig verstehe, dann produziert "Set appWord = GetObject(, "Word.Application")" einen Fehler, wenn es noch nicht geöffnet war. Aber wie funktioniert jetzt das ganze Zusammenspiel?
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If appWord Is Nothing Then
Set appWord = CreateObject("Word.Application")
xWordLiefNicht = True
End If
... weiter im Code....
If xWordLiefNicht Then
appWord.Quit
End If

Diese beiden Zeilen müssen aber weiterhin im Code bleiben, oder?

Set docWord = Nothing
Set appWord = Nothing

Anzeige
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 18:25:08
Excel
Noch mal zum Verständnis:
On Error Resume Next

ignoriert den Fehler und springt zur nächsten Zeile
On Error GoTo errorMsgWord

springt zu
errorMsgWord:
MsgBox Err.Description, 16, "Error"
Set docWord = Nothing
Set appWord = Nothing
End Sub

und schmeisst dich aus der Sub.
Da du ZWEI Errorhandler hattest, wurde der Erste einfach durch den Zweiten überschrieben und du flogst nach der MSGBOX aus der Sub.
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 18:53:21
Excel
alles klar, danke!
Was mich aber ein bisschen stört ist, dass hierbei lediglich der Fehler kuriert wird, wenn Word nicht offen war. Wie kann ich mir aber auch noch andere Fehler ausgeben lassen?
Anzeige
AW: Text von Excel an Word Textmarken übergeben
22.11.2017 19:41:48
Excel
Du kannst nach dem Öffnen der datei
on error goto 0
schreiben und der errorhandler ist wieder raus und der code unterbricht wieder bei jedem fehler.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige