Option Explicit
Private Sub ExportPdf()
Dim PrintDlg As DialogSheet
Dim Dossier As String
Dim CurrentSheet As Worksheet
Dim Sh As Worksheet
Dim Cb As CheckBox
Dim FileName As Variant
Dim TopPos As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dossier = "D:\"
' On ne peut ajouter un dialogsheet que sur un classeur non protégé
If ActiveWorkbook.ProtectStructure Then
MsgBox "Le classeur est protégé.", vbCritical
Exit Sub
End If
On Error Resume Next ' Suppresion du DialogSheet si existant
If Not Sheets("DlgExport") Is Nothing Then
Application.DisplayAlerts = False
Sheets("DlgExport").Delete
End If
On Error GoTo 0
Set CurrentSheet = ActiveSheet
' Ajout d'un dialog sheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
With PrintDlg
.Name = "DlgExport"
' Ajout des cases à cocher
TopPos = .Buttons(1).Top
For Each Sh In ActiveWorkbook.Worksheets
' Les feuilles vierges ou masquées sont ignorées
If Sh.Visible And (Sh.UsedRange <> "") Then
With .CheckBoxes.Add(.DialogFrame.Left + 8, TopPos, 100, 16.5)
.Text = Sh.Name
.Value = xlOn
End With
TopPos = TopPos + 13
End If
Next
' Move OK and Cancel buttons
.Buttons.Left = .CheckBoxes(1).Left + .CheckBoxes(1).Width
' dialog height, width, and caption
.DialogFrame.Height = 10 + Application.Max(TopPos, .Buttons(2).Top + .Buttons(2).Height) - .DialogFrame.Top
.DialogFrame.Width = 10 + .Buttons(1).Left + .Buttons(1).Width - .DialogFrame.Left
.DialogFrame.Caption = "Cochez les feuilles à publier"
.Buttons(1).BringToFront ' Set focus on Cancel
' Display the dialog box
Application.ScreenUpdating = True
If .Show Then
For Each Cb In .CheckBoxes
If Cb.Value = xlOn Then
With Sheets(Cb.Caption)
.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=Dossier & Cb.Caption & ".pdf"
End With
End If
Next Cb
End If
End With
' Delete temporary dialog sheet (without a warning)
PrintDlg.Delete
Set PrintDlg = Nothing
' Reactivate original sheet
CurrentSheet.Activate
Set CurrentSheet = Nothing
End Sub