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:\"
If ActiveWorkbook.ProtectStructure Then
MsgBox "Le classeur est protégé.", vbCritical
Exit Sub
End If
On Error Resume Next
If Not Sheets("DlgExport") Is Nothing Then
Application.DisplayAlerts = False
Sheets("DlgExport").Delete
End If
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
With PrintDlg
.Name = "DlgExport"
TopPos = .Buttons(1).Top
For Each Sh In ActiveWorkbook.Worksheets
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
.Buttons.Left = .CheckBoxes(1).Left + .CheckBoxes(1).Width
.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
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
PrintDlg.Delete
Set PrintDlg = Nothing
CurrentSheet.Activate
Set CurrentSheet = Nothing
End Sub