XL 2019 intégrer l'impression en pdf dans un code

[jrmy34]

Bonjour à vous,

Je souhaiterai pouvoir intégrer l'impression avec "PDF creator" dans ce code :

Private Sub CommandButton4_Click()
Dim O As Worksheet
CarryOn = MsgBox("Voulez-vous imprimer un bulletin individuel ?", vbYesNo, "Kutools for Excel") 'Message pour confirmer l'impression en oui/non
Ctr = -1
If CarryOn = vbYes Then 'si oui alors ...imprimer!
For Each O In Worksheets
    If Left(O.Name, 1) = "B" Then
        Debug.Print O.Range("D7").Value, Worksheets("Impression").Range("D10").Value
        If O.Range("D7").Value = Worksheets("Impression").Range("D10").Value Then O.PrintOut: Exit Sub
    End If
Next O
End If
End Sub

Merci à vous pour votre aide, elle a jusqu'à présent, été d'une grande efficacité !

 

[kiki29]

Salut, ici il y a plusieurs imprimantes physiques ( Epson, etc) et virtuelles ( PDFCreator,Acrobat) d'installées
Donc pour n'utiliser que PDFCreator et non l'imprimante par défaut ( sans y toucher )
Il s'agit de PDFCreator 1.7.3 ( ou 1.7.2 ) pas des 2.x, 3.x ou autres.

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Function GetPrinterWithPort(ByVal sPrinterName As String) As String
Dim Reg As Variant, oReg As Object, Str As Variant
Dim Ar() As Variant, RegValue As Variant
Const HKEY_CURRENT_USER = &H80000001
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    With oReg
        .enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Str, Ar
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Reg, RegValue
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", sPrinterName, RegValue
    End With
    GetPrinterWithPort = sPrinterName & " sur " & Mid$(RegValue, InStr(RegValue, ",") + 1)
End Function

Sub TstPdfCreator()
Dim sPrinter As String
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim Ar() As String, Cpt As Long, i As Long

    sNomPDF = "Essai"
    sCheminPDF = ThisWorkbook.Path & "\"
    sPrinter = GetPrinterWithPort("PDFCreator")

    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
    JobPDF.cStart "/NoProcessingAtStartup"

    With JobPDF
        .cPrinterStop = True
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sCheminPDF
        .cOption("AutosaveFilename") = sNomPDF

        '   0 PDF   1 PNG   2 JPEG  3 BMP       4 PCX       5 TIFF
        '   6 PS    7 EPS   8 TXT   9 PDF/A-2B  10 PDF/X    11 PSD
        '   12 PCL  13 RAW  14 SVG

        .cOption("AutosaveFormat") = 0
        .cOption("PDFGeneralAutorotate") = 0
        .cClearCache
    End With

    ' Pour n'imprimer que certaines feuilles du classeur
    ' il faut respecter l'ordre alphabétique des feuilles
    Cpt = 0: Erase Ar
    For i = 1 To ThisWorkbook.Sheets.Count
        If Left$(ThisWorkbook.Sheets(i).Name, 6) = "Feuil1" Or _
           Left$(ThisWorkbook.Sheets(i).Name, 6) = "Feuil2" Then
            ReDim Preserve Ar(Cpt)
            Ar(Cpt) = Sheets(i).Name
            Cpt = Cpt + 1
        End If
    Next i

    If Cpt = 0 Then
        Set JobPDF = Nothing
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Sheets(Ar).Select
    Sheets(Ar).PrintOut copies:=1, ActivePrinter:=sPrinter
    '    Sheets(Array("Feuil1", "Feuil2")).PrintOut copies:=1, ActivePrinter:=sPrinter
    Worksheets(1).Select
    Erase Ar
    Application.ScreenUpdating = True
    DoEvents

    '   Fichier dans la file d'attente
    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    '   Démarrage Imprimante
    JobPDF.cPrinterStop = False

    '   Attendre que la file d'attente soit vide
    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop

    JobPDF.cClose
    Set JobPDF = Nothing
End Sub