Option Explicit
Sub Impression()
Dim Ws As Worksheet
Dim oOle As OLEObject
Dim Ar() As String
Dim Cpt As Long
Dim sStr As String
Application.ScreenUpdating = False
Set Ws = ShParametres
Cpt = 0
For Each oOle In Ws.OLEObjects
If TypeOf oOle.Object Is MSForms.CheckBox Then
If Ws.OLEObjects(oOle.Name).Object.Value = True Then
ReDim Preserve Ar(Cpt)
sStr = Right$(oOle.Name, 2)
Ar(Cpt) = Sheets(sStr).Name
Cpt = Cpt + 1
End If
End If
Next oOle
If Cpt = 0 Then Exit Sub
Sheets(Ar).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & Format(Now, "yyyymmdd hhmmss") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Application.ScreenUpdating = True
Ws.Select
Set Ws = Nothing
End Sub