Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1740to1744
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
via Word-Dokument drucken klemmt
21.02.2020 11:32:36
G.W.
Guten Morgen, liebe vba-Spezialisten,
ich habe einen Code zum Drucken eines Word-Dokumentes erstellt. Der funktioniert auch, aber leider nur unregelmäßig. Oft wird das Word-Template nicht gestartet. Wenn ich Excel schließe und neu starte, geht es wieder. Wird wohl etwas mit den Instanzen zu tun haben. Ich meine, mit 'wrdApp.Quit' am Schluss alle Instanzen zu schließen. Aber ich sehe meinen Fehler nicht. Kann mir jemand auf die Sprünge helfen?
Private Sub CommandButton1_Click()
Dim wrdApp As Word.Application, wrdDoc As Word.Document, aDok As Word.Document, strTemp As  _
String, OUTPUTPATH As String, strFilenameDOC As String, strFilenamePDF As String, wrdopen As  _
Boolean
Dim path As String, ENVString As String
ENVString = Environ("Index")
If Left(ENVString, 1) = "C" Then
path = "C:\Users\user\Desktop\"
Else
path = "Pfadname"
OUTPUTPATH_DOC = "Pfadname" & "\DOC\"
OUTPUTPATH_PDF = "Pfadname" & "\PDF\"
End If
strTemp = path & "Template_" & Cells(ActiveCell.Row, 147) & ".dotx" 'Pfad zur jeweiligen  _
Vorlage (typabhängig)
Err.Clear
' Ort wo die Dokumente gespeichert werden
OUTPUTPATH = path
strFilenameDOC = Cells(ActiveCell.Row, 2)
strFilenamePDF = Cells(ActiveCell.Row, 2)
' Word öffnen
wrdopen = False
On Error Resume Next
Set wrdApp = GetObject(, "Word.Application") ' prüfen ob Word bereits geöffnet
If Err.Number  0 Then ' wenn Fehler, dann klären
Err.Clear
If wrdApp Is Nothing Then 			'wenn noch nicht geöffnet, jetzt öffnen
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
End If
Else
If wrdApp Is Nothing Then 			'wenn noch nicht geöffnet, jetzt öffnen
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
End If
wrdopen = True
End If
wrdApp.Visible = True
' Template laden und in neues Dokument kopieren
Set aDok = Documents.Add(Template:=strTemp, NewTemplate:=False, DocumentType:=0)
aDok.Activate
Application.Wait Now + TimeSerial(0, 0, 2)
MsgBox ("Dokument angelegt!")
'------ Dokument füllen!
' hier folgt der Aufbau des Dokumentes
aDok.ContentControls(1).Range.Text = Cells(ActiveCell.Row, 2)     'Art-Bezeichnung-Kopf
' Und so weiter bis alle Steuerelemente gefüllt sind
'------- Dokument drucken
aDok.PrintOut Background:=True
Application.Wait Now + TimeSerial(0, 0, 3)
aDok.Saved = True
' Dokument speichern
With aDok
.SaveAs2 OUTPUTPATH_DOC & "\" & strFilenameDOC
.ExportAsFixedFormat OUTPUTPATH_PDF & "\" & strFilenamePDF, wdExportFormatPDF
End With
aDok.Close
If wrdopen = False Then ' nur schließen, wenn Word beim Start nicht schon offen war
wrdApp.Quit
End If
' Variablen leeren
Set aDok = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub

Bin dankbar für Eure Unterstützung.
Lieben Gruß
G.W.

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

Betreff
Datum
Anwender
Anzeige
AW: via Word-Dokument drucken klemmt
21.02.2020 11:39:58
peterk
Hallo
Du hast ein "on error resume next" das für die gesamte Prozedur gilt!! Du solltest nach Deinem "If Err.Number" ein "on error goto 0" einfügen, damit Fehler wieder angezeigt werden.
AW: via Word-Dokument drucken klemmt
21.02.2020 12:10:25
G.W.
Danke, das macht das Problem deutlich!
Beim erneuten Aufruf der Druckroutine kommt die Fehlerroutine '462: Remote-Server-Computer existiert nicht oder ist nicht verfügbar.' Wie kriege ich dass denn in den Griff? Ich dachte mit einer Verzögerung 'Application.Wait Now + TimeSerial(0, 0, 2)' würde ich das abfangen können?
Lieben Gruß
G.W.
AW: via Word-Dokument drucken klemmt
21.02.2020 17:02:49
G.W.
Hallo,
ich glaube, ich habe jetzt im Netz eine stabile Lösung mit 'Set pobjWordApp = New Word.Application' gefunden. Warum diese den Fehler besser abfängt ist mir nicht klar, aber das Ergebnis zählt ja. Anscheinend wir hierbei nicht auf vorhandene Instanzen geprüft, sodaß der Fehler, der bei 'Create' oder 'getObject' auftrat, nicht mehr auftritt. Zunächst müssen die Variablen für Doc und App als public deklariert werden:
Public pobjWordApp as New Word.Application
Public pobjWordDoc as Word.Document
Danach funktioniert es mit 'Set pobjWordApp = New Word.Application' einwandfrei. Die Prozedur kann jetzt beliebig oft aufgerufen werden:
Private Sub CommandButton1_Click()
Dim wrdApp As Word.Application, wrdDoc As Word.Document, aDok As Word.Document, strTemp As  _
String, OUTPUTPATH As String, strFilenameDOC As String, strFilenamePDF As String, wrdopen As Boolean
Dim path As String, ENVString As String
ENVString = Environ("Index")
If Left(ENVString, 1) = "C" Then
path = "C:\Users\user\Desktop\"
Else
path = "Pfadname"
outputpath_doc = "Pfadname" & "\DOC\"
OUTPUTPATH_PDF = ""Pfadname" & "\PDF\"
End If
strTemp = path & "Fismer SD2_" & Cells(ActiveCell.Row, 147) & ".dotx" 'Pfad zur Vorlage
Err.Clear
OUTPUTPATH = path
strFilenameDOC = Cells(ActiveCell.Row, 2)
strFilenamePDF = Cells(ActiveCell.Row, 2)
wrdopen = False
'On Error Resume Next
Set pobjWordApp = New Word.Application
Application.Wait Now + TimeSerial(0, 0, 2) 'Warten bis Word gestartet ist
Set pobjWordDoc = pobjWordApp.Documents.Add(Template:=strTemp, NewTemplate:=False, DocumentType: _
=0)
Application.Wait Now + TimeSerial(0, 0, 2) 'Warten bis Dokument gestartet ist
pobjWordApp.Visible = True
MsgBox ("Dokument angelegt! Ausdruck beginnt mit 'OK'")
'------ Dokument erstellen!
pobjWordDoc.ContentControls(1).Range.Text = Cells(ActiveCell.Row, 2)     'Art-Bezeichnung-Kopf
'----- hier kommen die weiteren Steuerelemente
'------- Word sauber doc und .pdf speichern und schlieflen
With pobjWordDoc
.PrintOut Background:=True
.SaveAs2 outputpath_doc & "\" & strFilenameDOC
.ExportAsFixedFormat OUTPUTPATH_PDF & "\" & strFilenamePDF, wdExportFormatPDF
.Saved = True
.Close
End With
Set pobjWordDoc = Nothing
On Error Resume Next
pobjWordApp.Visible = False
pobjWordApp.Quit
Set pobjWordAppp = Nothing
On Error GoTo 0
End Sub
Danke für den wichtigen Hinweis, ohne den ich den Feher nicht entdeckt hätte. Vielleicht hat ja jemand eine Erklärung warum das so ist. Würde mich freuen.
Lieben Gruß
G.W.
Anzeige
AW: via Word-Dokument drucken klemmt
25.02.2020 18:20:12
fcs
Hallo G.W.,
mit der Anweisung
Set pobjWordApp = New Word.Application

Wird immer eine neue Instanz von Word erstellt und in der läuft dein Makro dann reibungslos.
Es sollte eigentlich auch funktionieren, wenn die Variablen per Dim innerhalb der Prozedur erstellt werden - aber auch beim Programmieren nter VBA gilt oft : Never change a running System.
Noch ein paar Hinweise:
  • Du solltest deine Variablen Deklaration aufräumen. Die Variablen wrdApp, wrdDok und aDoc werden in der Sub nicht mehr genutzt.

  • Die Zeile
    wrdopen = False
    

    inkl. der Variablen wrdopen ist überflüssig, denn die Variable wrdOpen wird im weiteren Verlauf des Makros nicht mehr benutzt.

  • Fehler-Behandlung:
    Das Problem der pauschalen Anweisung On Error Resume Next hast du ja schon kennengelernt.
    Ratsam ist eine ausführlichere Fehlerbehandlung mit Prüfung der Fehler-Nr. und gezielten Aktionen - Beispiel
    Sub Test()
    'Variablendeklarationen
    Dim wks As Worksheet, wkb As Workbook
    Dim StatusCalc As Long
    'usw.
    'Makrobremsen lösen
    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    StatusCalc = .Calculation
    .Calculation = xlCalculationManual
    End With
    On Error GoTo Fehler 'Diese Zeile erst nach dem Testen des Makros aktiv machen, _
    um ggf. Fehler zu erkennen
    'hier der eigentliche Code
    Resume01:  'Sprungadresse bei Fehler 4321
    'Fehlerbehandling - Prüfen der Fehlernummer
    With Err
    Select Case .Number
    Case 0 'alles OK
    Case 1234
    Resume Next 'Makro wird in der Zeile nach der Zeile mit dem Fehler fortgesetzt
    Case 4321
    Resume Resume01 'Makro wird an der Sprungadresse fortgestzt
    Case 9991
    MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
    & "Hinweis zum Fehler: Es ist etwas schief gegangen - Makro wird beendet.", _
    vbInformation + vbOKOnly, "Fehler Makro ""Test"""
    Case 9999
    'Code zur Korrektur bei Auftreten des Fehlers
    Resume 'Makro wird mit der Zeile mit dem Fehler fortgesetzt
    Case Else
    MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
    vbInformation + vbOKOnly, "Fehler Makro ""Test"""
    End Select
    End With
    'Hier ggf. noch Einstellungen zurücksetzen
    'Makrobremsen zurücksetzen
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = StatusCalc
    End With
    End Sub
    

  • LG
    Franz
    Anzeige

    182 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige