Drucken verhindern ABER pdf erstellen erlauben

[schauan]

Hallöchen,

der Fehler ist nur eingeschränkt reproduzierbar (2016).

Nach einfügen des codes und erstem Durchlauf trat der Fehler auf. Es konnte aber trotzdem gespeichert werden.
Anschließend bei weiteren Versuchen lief der Code problemlos, und das pdf wurde erzeugt.

Nach Schließen und Öffnen der Datei blieb der Code ohne Fehler in der pdf-Zeile stehen. Nach Betätigen von F5 lief der Code weiter, das pdf wurde gespeichert.
Anschließend bei weiteren Versuchen lief der Code problemlos, und das pdf wurde erzeugt.


Ich mach mir nebenbei mal noch ein paar Gedanken. Eventuell hilft ein Auslagern des codes und Starten mit OnTime oder ...

[atilla]

Hallo André,


Ich warte......


Spaß bei Seite, kann beim Export in PDF nicht Parameter mitgeben, dass nicht gedruckt werden sonder nur gespeichert werden soll?

[schauan]

Hallöchen,

also, mit dem OnTime wäre eine Möglichkeit. Beispiel siehe Anhang.

[atilla]

Hallo zusammen,

ich habe folgenden Code in einer Mappe:

Code:

Option Explicit
Dim boVar As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strgPath As String

'Prüfen ob alle notwendigen Felder ausgefüllt sind, erst wenn diese ausgefüllt sind wird die Datei zum Drucken/Speichern freigegeben
If ActiveSheet.Range("a1").Value = "0" Then
   MsgBox "      Die Datei wurde nicht vollständig ausgefüllt.:" _
   & vbCr & "" _
   & vbCr & " Seite 1: Es müssen alle Felder ausgefüllt sein" _
   & vbCr & " Seite 2: Wurde ein Feld ausgewählt muss in dieser Zeile auch die Checkliste ausgefüllt werden und umgekehrt." _
   & vbCr & "" _
   & vbCr & "" _
   & vbCr & "   Bitte alle Felder ausfüllen." _
   & vbCr & "" _
   & vbCr & "   Ansonsten kann nicht gedruckt werden." _
   & vbCr & "" _
   & vbCr & "                          Gruß", 48
   Cancel = True
   Exit Sub
End If
strgPath = ("C:\Users\UserName\Desktop\Neuer Ordner\")

If Dir(strgPath, vbDirectory) = "" Then
 MsgBox "Pfad existiert nicht!" & vbCrLf & vbCrLf & "Datei kann nicht gespeichert werden!"
 Exit Sub
End If
boVar = True

' Druckbereich festlegen
   ActiveSheet.PageSetup.PrintArea = "$B$1:$AE$97"

'Archiv-pdf erstellen
Dim pdfName As String
pdfName = strgPath & Range("K8") & "_" & Range("K6") & "_" & Range("K9") & "_" & Range("K13") & "_" & Format(Now, "YYYY_MM_DD-hh_mm_ss") & ".pdf"
   ActiveWorkbook.ExportAsFixedFormat Filename:=pdfName, Type:=xlTypePDF
boVar = False
End Sub


Private Sub Workbook_BeforePrint(Cancel As Boolean)
' Verhindert das Drucken
If boVar = False Then
 Cancel = True
 MsgBox "Drucken aus der Excel wurde verhindert." _
     & vbCr & "" _
     & vbCr & "Drucken nur als .pdf möglich." _
     & vbCr & "" _
     & vbCr & "Datei bitte als .pdf im Projekteordner abspeichern.", 48
 End If
End Sub

Ich habe nur noch eine kleine Prüfung auf Pfad eingebaut. Aber auch ohne, wenn der Pfad existiert kommt es mit dem Code zu keinen Fehlern.

Beim Drucken kommt Meldung: "Drucken nicht möglich...etc"
Beim Speichern, Datei wird am angegebenen Ort zusätzlich als Pdf gespeichert.

Es klappt nach mehrmaligem speichern schließen und öffnen immer noch einwandfrei.
Ich würde aber hier noch das BeforeClose mit einbinden.


Und Andre, ich bleib dabei, aber Du hattest leider kein Gegengebot gemacht. :39:

[schauan]

Hallo Atilla,

aber ich hatte doch erst mal ein Beispiel gepostet ... - was erwartest Du noch für ein Gegenangebot ? :20:

[Christian19]

Danke für den Tipp,
konnte mich leider bis jetzt nicht kümmern.

Werde mich nun aber mal dran setzen.
Ergebnis werde ich denn hier posten.

[Christian19]

Hallöchen,

also, mit dem OnTime wäre eine Möglichkeit. Beispiel siehe Anhang.

Danke für die Hilfe, aber ich werde keine Datein runterladen.
Nicht bei dem was momentan los is.
Da ist mir mein Job doch zu lieb.

;)

[atilla]

Hallo Atilla,

aber ich hatte doch erst mal ein Beispiel gepostet ... - was erwartest Du noch für ein Gegenangebot ?  :20:

Andre,

wenn ich falsch gelegen hätte, hätte ich drei Tabellen damit vollgekritzelt, dass ich unrecht habe.
Darauf hast Du nichts mehr erwidert, sondern hast im Grunde meine Variante mit OnTime ergänzt. Wobei ich überzeugt bin, dass OnTime hier fehl am Platz ist, wenn dann würde eher ein Application.Wait in der Print Routine Sinn machen.

Ob mit oder ohne Ontime, der Code funktioniert genauso wie mein eingestellter Code (weil er im Grunde mein Code ist) nur deswegen, weil die Variable boVar ins Spiel gebracht wurde.

[atilla]

Hallo,

dann stell ich den Code hier ein, damit man sehen kann, dass es im Grunde meine Variante ist.

Hinter DiseArbeitsmappe:

Code:

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Prüfen ob alle notwendigen Felder ausgefüllt sind, erst wenn diese ausgefüllt sind wird die Datei zum Drucken/Speichern freigegeben
If ActiveSheet.Range("a1").Value = "0" Then
 MsgBox "      Die Datei wurde nicht vollständig ausgefüllt.:" _
   & vbCr & "" _
   & vbCr & " Seite 1: Es müssen alle Felder ausgefüllt sein" _
   & vbCr & " Seite 2: Wurde ein Feld ausgewählt muss in dieser Zeile auch die Checkliste ausgefüllt werden und umgekehrt." _
   & vbCr & "" _
   & vbCr & "" _
   & vbCr & "   Bitte alle Felder ausfüllen." _
   & vbCr & "" _
   & vbCr & "   Ansonsten kann nicht gedruckt werden." _
   & vbCr & "" _
   & vbCr & "                          Gruß", 48
Cancel = True
Exit Sub
End If
Application.OnTime Now + TimeSerial(0, 0, 1), "ExportPDF"
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
' Verhindert das Drucken
If boVar = False Then
 Cancel = True
 MsgBox "Drucken aus der Excel wurde verhindert." _
     & vbCr & "" _
     & vbCr & "Drucken nur als .pdf möglich." _
     & vbCr & "" _
     & vbCr & "Datei bitte als .pdf im Projekteordner abspeichern.", 48
 End If
End Sub

In einem allgemeinem Modul:

Code:

Option Explicit
Public boVar As Boolean
Sub ExportPDF()
boVar = True
'Archiv-pdf erstellen
Dim pdfName As String
' Druckbereich festlegen
ActiveSheet.PageSetup.PrintArea = "$B$1:$AE$97"
pdfName = "C:\Users\Atilla\Desktop\Neuer Ordner (2)\" & Range("K8") & "_" & Range("K6") & "_" & Range("K9") & "_" & Range("K13") & "_" & Format(Now, "YYYY_MM_DD-hh_mm_ss") & ".pdf"
ActiveWorkbook.ExportAsFixedFormat Filename:=pdfName, Type:=xlTypePDF
boVar = False
End Sub

Wenn man hingeht und diese Zeile oben im Code :

Code:

Application.OnTime Now + TimeSerial(0, 0, 1), "ExportPDF"

so ersetzt:

Code:

call ExportPDF

Dann ist es praktisch meine Variante und funktioniert genauso, wie der von mir eingestellte Code in meiner letzten Antwort.

[Christian19]

Code:

'Option Explicit
Dim boVar As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strgPath As String

'Prüfen ob alle notwendigen Felder ausgefüllt sind, erst wenn diese ausgefüllt sind wird die Datei zum Drucken/Speichern freigegeben
If ActiveSheet.Range("AY109").Value = "0" Then
  MsgBox "      Die Datei wurde nicht vollständig ausgefüllt.:" _
  & vbCr & "" _
  & vbCr & " Seite 1: Es müssen alle Felder ausgefüllt sein" _
  & vbCr & " Seite 2: Wurde ein Feld ausgewählt muss in dieser Zeile auch die Checkliste ausgefüllt werden und umgekehrt." _
  & vbCr & "" _
  & vbCr & "" _
  & vbCr & "   Bitte alle Felder ausfüllen." _
  & vbCr & "" _
  & vbCr & "   Ansonsten kann nicht gedruckt werden." _
  & vbCr & "" _
  & vbCr & "                          Gruß", 48
  Cancel = True
  Exit Sub
End If
strgPath = ("C:\1x\2xx\3xxx\")

If Dir(strgPath, vbDirectory) = "" Then
MsgBox "Pfad existiert nicht!" & vbCrLf & vbCrLf & "Datei kann nicht gespeichert werden!"
Exit Sub
End If
boVar = True

' Druckbereich festlegen
  ActiveSheet.PageSetup.PrintArea = "$C$1:$AF$99"

'Archiv-pdf erstellen
Dim pdfName As String
pdfName = strgPath & Range("K8") & "_" & Range("K6") & "_" & Range("K9") & "_" & Range("K13") & "_" & Format(Now, "YYYY_MM_DD-hh_mm_ss") & ".pdf"
  ActiveWorkbook.ExportAsFixedFormat Filename:=pdfName, Type:=xlTypePDF
boVar = False
End Sub


Private Sub Workbook_BeforePrint(Cancel As Boolean)
' Verhindert das Drucken
If boVar = False Then
Cancel = True
MsgBox "Drucken aus der Excel wurde verhindert." _
    & vbCr & "" _
    & vbCr & "Drucken nur als .pdf möglich." _
    & vbCr & "" _
    & vbCr & "Datei bitte als .pdf im Projekteordner abspeichern.", 48
End If
End Sub

Bis auf ein paar Bezüge auf Zellen und den Pfad habe ich nichts geändert und ihn so probiert.

Ergbnis: 

Wenn in der entsprechenden Zelle (AY109) eine 0 steht:
 - Drucken wird verhindert
 - Speichern wird verhindert
beides mit der richtigen Fehlermeldung  


Wenn in der entsprechenden Zelle [u](AY109) eine 1 steht:[/u]
 - Speicher: Es kommt die Fehlermeldung, dass keine kein Drucken möglich ist. Nach dem Bestätigen dieser Meldung kommt ein Laufzeitfehler 1004, mit dem Verweis auf "ActiveWorkbook.ExportAsFixedFormat Filename:=pdfName, Type:=xlTypePDF". :22:

 - Drucken nicht möglich, mit der richtigen Fehlermeldung