XL 2019 Macro qui exporte au format PDF bloquée par BeforePrint = Cancel = True

[pat66]

Bonsoir le forum,
J'utilise BeforePrint(Cancel As Boolean) = Cancel = True, pour bloquer l'impression, mais cela bloque aussi la macro qui est sensée exporter en pdf

Peut on interdire d'imprimer mais permettre l'exportation en pdf le temps d'une macro ?

Merci

 

[patricktoulon]

je sais pas je n'ai pas testé mais en réfléchissant une demie seconde
normalement ton imprimante virtuelle PDF contient pdf dans son nom
avec compare text pour faire sauter la casse tu devrais être bon avec ça

Option Compare Text
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Not ActivePrinter Like "*pdf*" Then Cancel = True Else Cancel = False
End Sub

reste a savoir pourquoi tu exporte avec l'imprimante pdf alors que tu a le save As pdf

 

[pat66]

re,

cela bloque dans la macro pdf à la ligne :

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Nom_Fichier, IgnorePrintAreas:=False, OpenAfterPublish:=False

et la deuxieme fois ca a imprimé normalement, l'imprimante normale n'est pas bloquée

J'ai aussi bloqué la fonction save as avec
If SaveAsUI = True Then Cancel = True

 

[patricktoulon]

re
Bonjour
et pourquoi bloque tu le save UI ??
à quoi ça te sert ??
dis moi a quoi ça te sert de passer par l'imprimante virtuelle pdf alors que tu peux presque tout faire avec le save As
j'avoue que c'est flou ton truc

 

[pat66]

Bonjour,
Je souhaite que l'on puisse imprimer uniquement en PDF,
Je souhaite que l'on puisse pas modifier le nom du classeur original
Je souhaite que l'on enregistre uniquement de cette manière :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then MsgBox ("La commande 'Enregistrer sous...' est désactivée !"), 16, "PL" Else MsgBox ("La commande 'Enregistrer ...' est désactivée !"), 16, "PL"
Cancel = True
End sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Dim Answr As Byte
  Answr = MsgBox("Voulez-vous enregistrer les modifications apportées au " & Me.name & " avant de le fermer ? " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Pour annuler la fermeture, cliquez sur annuler", vbYesNoCancel + 32, "PL - Fermeture de l'application")
  Application.EnableEvents = False
  Select Case Answr
    Case vbYes: Me.Save
    Case vbNo: Me.Saved = True
    Case Else: Cancel = True   ': Exit Sub
    Application.EnableEvents = True
  End Select
End Sub

Il y peut être des incohérences, mais comme je suis en plein écran, je souhaite que l'on utilise seulement la croix rouge pour fermer la classeur, voir BeforeClose(Cancel As Boolean) ci dessus

Mais il me manque la possibilité d'empêcher l'impression, tout en permettant d'imprimer en PDF avec cette macro :

Sub Print_PDF_Click()
'Dim Mdp As String
'Mdp = Application.InputBox("Veuillez introduire le mot de passe", "PL")
'If Mdp <> "jojo" Then MsgBox "Accès refusé !", vbOKOnly + vbInformation, "PL": Exit Sub
Application.ScreenUpdating = False
If Sheets("transmettre").Range("d6") = "" Then MsgBox "Veuillez préciser le nom et le prénom !", vbCritical, "PL": Exit Sub
Dim Sh1 As Worksheet
Set Sh1 = Feuil5 'A adapter si besoin en fonction du codename de la feuille 1
With Sh1.PageSetup
.PrintArea = "C1:M110" 'Zone d'impression à adapter de la feuille 1
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 3
'Réglage des marges
.LeftMargin = Application.InchesToPoints(0.3) 'Marge gauche
.RightMargin = Application.InchesToPoints(0.3) 'Marge droite
.TopMargin = Application.InchesToPoints(0.3) 'Marge haut de page
.BottomMargin = Application.InchesToPoints(0.4) 'Marge bas de page
.Orientation = xlLandscape 'Paysage     ' .Orientation = xlPortrait 'Portrait
End With
Sheets(Array(Sh1.name)).Select

Dim Nom_Fichier$, Titre_Box$, Test_Fichier As Byte
Titre_Box = "Export PDF"

Nom_Fichier = ThisWorkbook.Path & "\" & "PROSPECT" & "-" & Sh1.Range("d6") & "-" & Sh1.Range("d7") & "-" & Format(Date, "dd-mm-yyyy")
'Nom_Fichier = Sh1.Range("d6") & "-" & Sh1.Range("d7") & "-" & Sh1.Range("d9") & Format(Date, "-dd-mm-yyyy")
Do
    Test_Fichier = 0
    Nom_Fichier = Application.GetSaveAsFilename(Nom_Fichier, FileFilter:="Fichiers PDF (*.pdf),*.pdf", Title:=Titre_Box)
    If Not (Dir$(Nom_Fichier, vbNormal) = "") Then Test_Fichier = MsgBox(LCase(Nom_Fichier) & " existe déja" & vbLf & "en date du " & DateValue(FileDateTime(Nom_Fichier)) & vbLf & "voulez vous l'écraser ?", vbYesNo + vbQuestion, "PL")
    If Test_Fichier = vbNo Then Titre_Box = "Redéfinissez le nom d'enregistrement"
    If Nom_Fichier = "Faux" Then MsgBox "Annulation, fichier  PDF non exporté !", vbOKOnly + vbInformation, "PL": Exit Sub
Loop While Test_Fichier = vbNo
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Nom_Fichier, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sh1.Select '<=== A rajouter
MsgBox "Le PDF a été enregistré." & vbCrLf & vbCrLf & "Ici ==> " & Nom_Fichier, 64, "PL"

Set Sh1 = Nothing 'Decharge la feuille 1
'ActiveWindow.Close
Application.ScreenUpdating = True
End Sub