Problème place box impression

Bonjour à tous et toutes,

J'espère que votre santé est au top.

J'ai un petit souci. Lorsque je veux ouvrir ma boite de dialogue pour sélectionner une feuille où plus dans un classue via une bte de dialogue.

Il m’indique que j'ai trop de feuille ( pas de place) dans le box afin de sélectionner les feuilles à imprimer.

Jusque là tout aller bien.

Mon classeur à 14 feuilles (12 mois+paramètres+bilan.

Si vous avez la solution, J'apprécierais réellement.

Bonne journée à vous.

Balancie.

Re- bonjour,

Avec le fichier c'est mieux..

Public i As Integer, Arr(), X&
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Public flag
Sub ChoixImpressionFeuilles() '-----------------------------------

  Application.ScreenUpdating = False

 Call dial("Choix de(s)Feuille(s) à imprimer.")
'  Supprime la feuille de dialogue temporaire (sans message d'avertissement)
  Application.DisplayAlerts = False
  PrintDlg.Delete
  If flag = 0 Then Exit Sub

'  Sélectionne les feuilles et montre un aperçu avant impression
  Sheets(Arr).Select
  ActiveWindow.SelectedSheets.PrintPreview
  'pour imprimer :
 'ActiveWindow.SelectedSheets.PrintOut
End Sub

Sub dial(titre)
flag = 0
  If Sheets.Count > 60 Then
    MsgBox "Trop de feuilles pour la boite de dialogue..."
    Exit Sub
  End If

'  Ajoute une feuille de dialogue temporaire
  If ActiveWindow.SelectedSheets.Count > 1 Then Sheets(1).Activate
  Set PrintDlg = ActiveWorkbook.DialogSheets.Add
  PrintDlg.Visible = xlSheetHidden

  SheetCount = 0

'  Ajoute les boutons d'option
  TopPos = 40
  For i = 1 To ActiveWorkbook.Worksheets.Count
    Set CurrentSheet = ActiveWorkbook.Worksheets(i)
'   Ne tient pas compte des feuilles vide ou masquées
    If Application.CountA(CurrentSheet.Cells) <> 0 And _
            CurrentSheet.Visible Then
      SheetCount = SheetCount + 1
      PrintDlg.CheckBoxes.Add 78, TopPos, 120, 16.5
      PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name
      TopPos = TopPos + 13
    End If
  Next i

'  Positionne les boutons OK et Annuler
  PrintDlg.Buttons.Left = 200

'  Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
  With PrintDlg.DialogFrame
    .Height = Application.Max _
            (68, PrintDlg.DialogFrame.Top + TopPos - 34)
    .Width = 200
    .Caption = titre
  End With

'  Change l'ordre de tabulation des boutons OK et Annuler
'  afin de donner le focus au premier bouton d'option
  PrintDlg.Buttons("Button 2").BringToFront
  PrintDlg.Buttons("Button 3").BringToFront

'  Affiche la boîte de dialogue
  Application.ScreenUpdating = True
  If SheetCount <> 0 Then
    If PrintDlg.Show = True Then
      X = -1
      Application.ScreenUpdating = False
      For i = 1 To SheetCount
        If PrintDlg.CheckBoxes(i).Value = xlOn Then
          X = X + 1: ReDim Preserve Arr(X)
          Arr(X) = PrintDlg.CheckBoxes(i).Caption
          flag = 1
        End If
      Next i
    Else: Exit Sub
    End If
  Else
    MsgBox "Toutes les feuilles sont vides !"
  End If
End Sub

'Sauvegarde du Mois chois en PDF depuis PARMETRES.A doubler avec ImprimerChoix

Sub SauvMois()

Dim dossier As String
Dim ws As Object
Dim nom, feuille As String
Call dial("Sauver en PDF. Choix Feuille(s).")

If flag = 0 Then Exit Sub
'emplacement a derterminée
'If MsgBox(" Générer PDF Mois ?", vbYesNo, _
'"Demande de confirmation") <> vbYes Then Exit Sub

'Set ws = Sheets(InputBox("Quelle feuille souhaitez-vous sauvegarder?"))

'dossier = ChoixDossier
With Application.FileDialog(msoFileDialogFolderPicker)
 .Show
 If .SelectedItems.Count = 0 Then Exit Sub
 dossier = .SelectedItems(1)
If dossier = "" Then Exit Sub
End With
For n = 0 To UBound(Arr)
Set ws = Sheets(Arr(n))
 nom = InputBox("Nom du fichier :", "Nom des fichiers", Arr(n))
 If nom = "" Then Exit Sub
nom = dossier & "\" & nom

Next
If MsgBox("Souhaitez-vous ouvrir le fichier dans Reader?", vbYesNo) = vbNo Then
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nom _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Else
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nom _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End If

End Sub