Bonjour Zon
J' uyilise le code du menu de Bernard Roy et le voici; le pb c' est qu' il affiche toutes les feuilles et comme j' ai dit dans l' autre post y aurait il un code a ajouter afin que les feuilles en xlverhiddenne ne soit pas affiché
Sub AccesSection()
'code diffusé par René Roy, mpfe
' Permet l'affichage d'une boîte de dialogue pour l'accès
' à la section de son choix
Dim I As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
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.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next I
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' 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 = 230
.Caption = "Quelle section souhaitez-vous accéder ? "
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
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For I = 1 To SheetCount
If PrintDlg.OptionButtons(I).Value = xlOn Then
Worksheets(PrintDlg.OptionButtons(I).Caption).Activate
CelluleEnCours = ActiveCell.Address
Range("A:S").Select
ActiveWindow.Zoom = True
Range(CelluleEnCours).Select
ActiveWindow.Zoom = 85
End If
Next I
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
End Sub
AL
