Drucken verhindern ABER pdf erstellen erlauben

[Christian19]

@ Atilla

siehe den Code oben, die von dir vermisste Zeile habe ich gerade engefügt.

auch die Zeile

    Cancel = True

Hat Leider nichts verändert.

---------------------------------------------------------


Sobal man von einem Sub in den anderen springt ist boVar Leer.

[atilla]

Hallo Christian,

das letzte Cancel=True hat nichts mit Deinem eigentlichen Problem zu tun. Das verhindert das Speichern der Vorlage deswegen auch überhaupt nicht sinnvoll.
Da es nicht gespeichert werden kann, wird es auch nicht wieder da sein und gut.

Nu zum eigentlichen Problem.

Was sagt den BoVar jetzt, wenn der Code schrittweise ausgeführt wird.

Also ein Stop vor If BoVar im BeforPrint

Ansonsten, solange Du das Ganze nicht außerhalb des Netzwerks testen kannst, kannst du nicht ausschließen, dass die Probleme daran liegen.

[atilla]

Hallo Christian,

Du vermischst Code.

Der eingestellte Code ist die Variante von Andre mit der ausgelagerten Prozedur in einem allgemeinen Modul.
Dann muss boVar auch dort rein, hatte ich aber geschrieben.

Also, zum Testen entweder das alles im Code Modul DieseArbeitsmappe:

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\Atilla\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

oder Andres Variante, wlche  ich im Beitrag 29# eingestellt und dort geschrieben habe, wo welche Teile hin müssen.

[Christian19]

Hallo Christian,

Du vermischst Code.

Der eingestellte Code ist die Variante von Andre mit der ausgelagerten Prozedur in einem allgemeinen Modul.
Dann muss boVar auch dort rein, hatte ich aber  geschrieben.

Also, zum Testen entweder das alles im Code Modul DieseArbeitsmappe:

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\Atilla\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

oder Andres Variante, wlche  ich im Beitrag 29# eingestellt und dort geschrieben habe, wo welche Teile hin müssen.

Auch wenn ich gerade ein wenig voreilig sein sollte: :100: :15: :19:  
Habe ich wirlich Vorschläge nicht richtig befolgt? verdammt aber auch
Habe den Code, so wie er hier ist übernommen, nur meine "autostart" #47 zwischen

Code:

Dim boVar As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

gesetzt.



Melde mich gleich nocheinmal

[Christian19]

bei "0" ( weder Drucken noch Spreichern)

# "Speichern unter"
- Backup pdf wird erstellt. :21:  , sollte nicht, kann man aber mit Leben.
- im Anschlus kommt die Meldung aus BeforePrint

# Drucken
- Meldung aus BeforePrint und es wird nichts gespeichert/gedruckt



bei "1" ( Nicht Drucken, aber Speichern (direktes erstellen einer pdf und BackupPdf erstellen)
# Speichern Unter
- Backup pdf wird erstellt
- Im Anschls kommt die Meldung aus BeforePrint und die Meldung das keine Datei gespeichert wurde.
- heißt: ich kann zu Fuss keine pdf erstellen   :21:  , muss die Datei erst als Excel ohne Makro abspeichern und denn kann ich daraus eine pdf erstellen. Direkter wäre besser

# Drucken
- Meldung aus BeforePrint und es wird nichts gespeichert/gedruckt.

Es kommem keine Fehlermeldungen 


Also, Ergbnis zu 95,31415% erfüllt ;) 



Ich danke für die Hilfe und Sorry, wenn es, durch mein unfähiges Kopieren des Codes, lange gedauert hat.

[atilla]

Hallo Christian,

zeig bitte den gesamten verwendeten Code.
Ich habe das Gefühl, dass Du es nicht richtig eingepflegt hast.

Denn was Du bei 0 beschreibst sollte und dürfte bei richtiger Anwendung nicht passieren und bei mir passiert das auch nicht.

[Christian19]

Hallo Christian,

zeig bitte den gesamten verwendeten Code.
Ich habe das Gefühl, dass Du es nicht richtig eingepflegt hast.

Denn was Du bei 0 beschreibst sollte und dürfte bei richtiger Anwendung nicht passieren und bei mir passiert das auch nicht.

Code:

'Übergreifende Variable
'-----------------------
Dim boVar As Boolean

Private Sub Workbook_Open()
'öffnet das Makro "Autostart"
'-----------------------------
   ' Druckbereich festlegen
   ' Zellen leeren
   ' Sichtbereich auf dem Monitor bestimmen
   ' Springe in Zelle E20
Call autostart

End Sub

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:\1x\1xx\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("o6") & "_" & Range("o8") & "_" & Range("o3") & "_" & 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

Code:

Sub autostart()

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


' Zellen leeren
   Range("D103:D103").ClearContents
   
' Sichtbereich auf dem Monitor bestimmen
   Columns("A:AF").Select
   Range("AF1").Activate
   ActiveWindow.Zoom = True
   
   
       
' Springe in Zelle E20
   Range("O3").Select

boVar = False

End Sub

[atilla]

Hallo Christian,

habe den Code jetzt bei mir hinein kopiert.

Folgendes passiert bei 0:
-Speichern oder Speichern unter: Msgbox mit Meldung und keine Speicherung
-Drucken: MsgBox und kein Druck

Bei 1:
-Speichern oder Speichern unter: Pdf wird angelegt, Datei wird gespeichert
--Drucken: MsgBox und kein Druck

So, wie es sein soll richtig.

Das es bei Dir nicht so ist, liegt dann wahrscheinlich am Netzwerk. Um das herauszufinden, halt mal an einem lokalen Ort testen.

[Christian19]

Danke Euch allen, für die Hilfe, Geduld,....

So wie der Code momentan aussieht und was er hier bei mir macht bin ich schon sehr zu.

Ja, ich werde weiter probieren ihn zu verfeinern ;)


Danke
Christian

[Christian19]

Code:

'Übergreifende Variable
'-----------------------
Dim boVar As Boolean

Private Sub Workbook_Open()
'öffnet das Makro "Autostart"
'-----------------------------
   ' Druckbereich festlegen
   ' Zellen leeren
   ' Sichtbereich auf dem Monitor bestimmen
   ' Springe in Zelle E20
   ' beVar Setzen
   
Call autostart

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

boVar = False

'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("A3").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 / gespeichert werden." _
  & vbCr & "" _
  & vbCr & "                          Gruß", 48
  Cancel = True
  Exit Sub
End If

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

' Pfad für die Archiv - PDF
'---------------------------
Dim strgPath As String
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

'Archiv-pdf Dateiname und pdf erstellen
'----------------------------------------
boVar = True 'Für die If Schleife in BeforePrint, damit die Archiv-pdf erstellt wird.
Dim pdfName As String
   pdfName = strgPath & Range("o6") & "_" & Range("o8") & "_" & Range("o3") & "_" & Format(Now, "YYYY_MM_DD-hh_mm_ss") & ".pdf"
       ActiveWorkbook.ExportAsFixedFormat Filename:=pdfName, Type:=xlTypePDF
boVar = True

End Sub


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

Danke nocheinmal.

Ich habe ein paar Änderungen an dem Code vorgenommen.
Eigentlich nur der Definition von boVar.
Aber nun klappt alles so wie ich es brauche.

Danke für die Hilfe und Geduld.
:15: