XL 2019 Problème ouverture box.

BALANCIE

XLDnaute Junior
Bonjour et bonne santé à tous et toutes.

J'ai un petit problème d'ouverture sur un classeur excel.
J'ai un classeur excel avec 14 feuilles.
J'ai une macro qui jusque là marchait bien. Cette cod me permet d'ouvrir une boite de dialogue ou je peux sélectionner plusieurs feuilles pour l'impression.
Mais voilà, elle m'indique que j'i trop de feuilles pour le format de ma boite de dialogue.
Pouvez-vous m'éclairer et me dépanner.
Merci à vous.
BALANCIE.

Voici les cods.


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
 

Statistiques des forums

Discussions
312 088
Messages
2 085 203
Membres
102 818
dernier inscrit
NeoMaint