Office: PDF geöffnet - speichern nicht möglich

Hallo,

ich würde gerne mein Makro zum Sperichern unter als PDF erweitern.
Wenn das PDF bereits geöffnet ist und ich versuche es erneut unter demselben Namen abzuspeichern erscheint die Fehlermeldeung: Laufzeitfehler 1004: Das Dokument wurde nicht gespeichert. Das Dokument ist möglicherweise geöffnet,...
und dann kann man "Beenden" oder "Debuggen" drücken.

Dass hier eine Fehlermeldung erscheint ist ja in Ordnung, aber ich hätte gerne eine MsgBox bei der man nicht auf Debuggen gehen kann. Das Dokument ist für mehrere Personen vorgesehen und "Debuggen" würde hier verwirren.

Am besten wäre ein kurzer Text "Das Dokument ist geöffnet. Speichervorgange nicht möglich." und man soll nur auf "OK" klicken können.

Ich hoffe jemand kann mir helfen, dies in dem Code zu integrieren.
Meine Versuche mit IsFileOpen waren ohne Erfolg.
Ich bin noch Anfänger, falls jemand eine Idee hat, wäre es super, dies bitte gleich in den bestehenden Code zu integrieren.

Vielen Dank im Voraus.

LG, Veronika


Sub Drucken()
'
' Drucken Makro
'
Dim myDateiname As String, mySpeicherort As Variant

myDateiname = "Checkliste" & "_" & Range("C9").Value & ".pdf"
mySpeicherort = Application.GetSaveAsFilename(InitialFileName:=myDateiname, _
FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Als PDF speichern")


If mySpeicherort <> False Then

If Dir(mySpeicherort) = "" Then ' Dateiname NICHT vorhanden.


Worksheets("Checkliste").ExportAsFixedFormat Type:=xlTypePDF, Filename:=mySpeicherort, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False



Else
If MsgBox("Datei ist bereits vorhanden. Möchten Sie diese ersetzen?", vbYesNo) = vbYes Then
Worksheets("Checkliste").ExportAsFixedFormat Type:=xlTypePDF, Filename:=mySpeicherort, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End If
End If
End If


End Sub

 

So z.B.

Code:

Sub Drucken()
'
' Drucken Makro
'
Dim myDateiname As String, mySpeicherort As Variant

myDateiname = "Checkliste" & "_" & Range("C9").Value & ".pdf"
mySpeicherort = Application.GetSaveAsFilename(InitialFileName:=myDateiname, _
FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Als PDF speichern")

   If mySpeicherort <> False Then
  
      If Dir(mySpeicherort) = "" Then ' Dateiname NICHT vorhanden.
         Worksheets("Checkliste").ExportAsFixedFormat Type:=xlTypePDF, Filename:=mySpeicherort, _
         Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      Else
         If MsgBox("Datei ist bereits vorhanden. Möchten Sie diese ersetzen?", vbYesNo) = vbYes Then
            On Error GoTo ErrRow
            Worksheets("Checkliste").ExportAsFixedFormat Type:=xlTypePDF, Filename:=mySpeicherort, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
         End If
      End If
   End If
Exit Sub
ErrRow:         Antwort = MsgBox("Die Datei ist geöffnet und kann nicht überschrieben werden." & _
vbCrLf & "Datei schließen und erneut versuchen.", vbOKOnly + vbCritical, "Evaluation")
End Sub

 

Guten Morgen Diza,

vielen Dank für die rasche Rückmeldung. Leider kommt die ErrRow nun auch, wenn das PDF gar nicht geöffnet ist.
also wenn ich die vorhanden PDF Datei ersetzen möchte und nicht geöffnet ist.
wie kann ich das nun noch einbauchen? Danke im Voraus.

LG, Veronika

 

Guten Morgen Veronika,
bei mir nicht und das ist eigtl. auch nicht möglich, da die Routine, wenn kein Fehler beim Überschreiben auftritt, vor dem ErrRow beendet wird und gar nicht dahin kommt.

 

Guten Morgen Diza,

sorry, funktioniert doch perfekt. vielen, vielen Dank :-)

LG, Veronika