Comment enregistrer excel en pdf...besoin d'aide svp

fanch55 à dit:

Bonsoir,
Vous voulez donc imprimer chaque onglet choisi dans un fichier Pdf différent ?
Ci-joint le code modifié pour prendre la colonne B2 de chaque Onglet :

VB:

Option Explicit
Private Sub CommandButton2_Click()
Dim PrintDlg        As DialogSheet
Dim CurrentSheet    As Worksheet
Dim Sh              As Worksheet
Dim Cb              As CheckBox
Dim FileName        As Variant
Dim TopPos          As Integer

Application.ScreenUpdating = False

    ' Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Le classeur est protégé.", vbCritical
        Exit Sub
    End If

    ' Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    ' Add the checkboxes
    TopPos = PrintDlg.Buttons(1).Top
    For Each Sh In ActiveWorkbook.Worksheets
        ' Skip hidden sheets
        If Sh.Visible Then
           PrintDlg.CheckBoxes.Add(78, TopPos, 100, 16.5).Text = Sh.Name
           TopPos = TopPos + 13
        End If
    Next
   
    ' Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = PrintDlg.CheckBoxes(1).Left + PrintDlg.CheckBoxes(1).Width
   
    ' Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = Application.Max(68, PrintDlg.DialogFrame.Top + TopPos - 34)
        .Width = PrintDlg.Buttons(1).Left ' <-- bizarre mais fonctionne
        .Caption = "Cochez les feuilles à publier"
    End With
   
    ' Set focus on Cancel
    PrintDlg.Buttons(1).BringToFront
   
    ' Display the dialog box
    CurrentSheet.Activate
    Application.ScreenUpdating = True
        If PrintDlg.Show Then
            Dossier = "D:\....\....\"
            For Each Cb In PrintDlg.CheckBoxes
                If Cb.Value = xlOn Then
                    With Sheets(Cb.Caption)
                        .ExportAsFixedFormat Type:=xlTypePDF, _
                        FileName:=Dossier & .Range("B2") & ".pdf"
                    End With
                End If
            Next Cb
        End If

    ' Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete

' Reactivate original sheet
CurrentSheet.Activate
Set CurrentSheet = Nothing
Set PrintDlg = Nothing

End Sub

Nota:
n'oubliez pas de renseigner le Dossier..
si le nom de l'onglet désigne déjà la région,
remplacez .Range("B2") par .name

Cliquez pour agrandir...