Zone de liste déroulante qui ne renvoie que vers certains onglets

**BaelBender** · 30/05/2014, 11h11

Bonjour,

Je souhaite créer une liste déroulante où s'affiche le nom de différents onglets. Lorsque l'on clique sur un de ces noms, ça nous renvoie vers l'onglet souhaité.

J'ai récupéré des bouts de codes à droite à gauche et j'ai réussi à obtenir une liste déroulante qui permet d'aller sur l'onglet de son choix. Mais je n'arrive cependant pas à limiter cette liste à certains onglets que j'aurais choisi.

Comment puis-je modifier le code pour ne donner accès qu'à certains onglets ?

Voila mes modules :

Module 1 :

Private Sub Workbook_Open()
AjouterElementMenu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteMenuItem
End Sub

Module 2

Sub AjouterElementMenu()
Dim ViewMenu As CommandBarPopup
Dim NewMenuItem As CommandBarButton

'Supprimer le menu s'il existe déjà
Call DeleteMenuItem

'Trouver le Menu Affichage
Set ViewMenu = CommandBars(1).Controls("Affichage")
If ViewMenu Is Nothing Then
MsgBox "Impossible d'ajouter l'élément de menu !"
Exit Sub
Else
Set NewMenuItem = ViewMenu.Controls.Add _
(Type:=msoControlButton)
With NewMenuItem
.Caption = "&Mon menu"
.OnAction = "AficheFeuille"
End With
End If
End Sub

Sub AficheFeuille()
UserForm1.Show
End Sub

Sub DeleteMenuItem()
On Error Resume Next
CommandBars(1).Controls("Affichage").Controls("Mon menu").Delete
End Sub

Et l'UserForm :

Option Explicit
Public OriginalSheet As Object

Private Sub UserForm_Initialize()
Dim SheetData() As String
Dim ShtNum As Integer
Dim ShtCnt As Integer
Dim Sht As Object
Dim LisPost As Integer

Set OriginalSheet = ActiveSheet
ShtCnt = ActiveWorkbook.Sheets.Count
ReDim SheetData(1 To ShtCnt, 1 To 4)
ShtNum = 1

For Each Sht In ActiveWorkbook.Sheets
If Sht.Name = ActiveSheet.Name Then _
LisPost = ShtNum - 1
SheetData(ShtNum, 1) = Sht.Name
Select Case TypeName(Sht)
Case "WorkSheet"
SheetData(ShtNum, 2) = "Feuil"
SheetData(ShtNum, 3) = Application.CountA(Sht.Cells)
End Select
ShtNum = ShtNum + 1
Next Sht
With ComboBox1
.ColumnWidths = "30 pt;30 pt; 40 pt;50 pt"
.List = SheetData
.ListIndex = LisPost
End With
End Sub

Private Sub ComboBox1_Change()

Sheets(ComboBox1.Value).Activate

End Sub

Merci d'avance,

**Philippe Tulliez** · 30/05/2014, 11h38

Bonjour,
Nulle besoin de code VBA pour cela.
Tu fais un clic droit au niveau des flèches de navigation (en bas à gauche des onglets) et tu auras la liste des feuilles et il suffit alors de sélectionner le nom de la feuille pour activer celle-ci.
[EDIT]
Désolé, je n'avais pas lu la limitation souhaitée

Mais je n'arrive cependant pas à limiter cette liste à certains onglets que j'aurais choisi.
Comment puis-je modifier le code pour ne donner accès qu'à certains onglets ?

mais il me semble que tu as déjà utilisé l'instruction de comparaison If Sht.Name = ActiveSheet.Name Then
il suffit donc d'utiliser

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Sht.Name = "Nom de la feuille" Then

**BaelBender** · 30/05/2014, 11h47

Je tiens vraiment à mes zones de liste déroulante

.

C'est un classeur excel assez important ( une centaine de feuille ) qui est une synthèse des activités d'un service de 25 personnes.
J'aurais en gros deux listes déroulantes différentes : - Une pour chaque semaine de l'année
- Une pour chaque agent du service

Et j'essaie de rendre le classeur facilement utilisable

EDIT : Lorsque je mets le nom de la feuille que je souhaite, la liste déroulante s'ouvre sur ce choix mais je peux toujours sélectionner les autres. Je ne comprends pas trop pourquoi non plus.

**Philippe Tulliez** · 30/05/2014, 12h06

Bonjour,
Est-ce un problème de lister certaines feuilles ou bien d'empêcher d'en sélectionner certaines ?
En attendant voici deux exemples de procédures listant certaines feuilles. Il s'agit bien entendu d'une simple liste et pas d'un menu mais il suffit d'adapter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub Exemple_1()
 ' Lister toutes les feuilles dont le nom commence par la lettre C
 Dim sht As Worksheet, txt$, Num%
 txt = "Liste des feuilles projets du classeur"
 For Each sht In ThisWorkbook.Worksheets
  If Left(sht.Name, 1) = "P" Then
   Num = Num + 1: txt = txt & vbCrLf & Format(Num, "000") & " - " & sht.Name
  End If
 Next
 MsgBox txt
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Exemple_2()
 ' Lister toutes les feuilles excepté celle dont le nom est
 '   MENU ou commence par Exercice
 Dim sht As Worksheet, txt$, Num%
 txt = "Liste des feuilles projets du classeur"
 For Each sht In ThisWorkbook.Worksheets
  If LCase(sht.Name) <> "menu" And Left(LCase(sht.Name), 8) <> "exercice" Then
   Num = Num + 1: txt = txt & vbCrLf & Format(Num, "000") & " - " & sht.Name
  End If
 Next
 MsgBox txt
End Sub

**BaelBender** · 30/05/2014, 12h58

Merci pour ces réponses

.

Les deux exemples que tu viens de me donner sont très intéressant.

J'ai cependant un petit souci :
- J'aimerais remplacer la ligne " If Sht.Name = ActiveSheet.Name Then " par " If Left(sht.Name, 1) = "1" Then "
Lorsque je fais cela, le message d'erreur suivant s'affiche : " Erreur de compilation : Next sans For " et je ne comprends pas pourquoi.

**Philippe Tulliez** · 30/05/2014, 13h51

Bonjour,
Sauf erreur de ma part et après relecture de ton code, il semblerait que tu aies oublié le End If.
Le message d'erreur dans ces cas là n'est pas toujours exact. Quand il manque un End With le même type de message s'affiche.
Tu aurais intérêt à indenter ton code pour mieux le visualiser.

**BaelBender** · 30/05/2014, 13h58

Effectivement, il manquait le end if.

Cependant j'ai toujours le même souci : Tout les onglets s'affichent et sont sélectionnables.

EDIT : J'ai trouvé l'erreur. Merci beaucoup

**Philippe Tulliez** · 30/05/2014, 14h30

Bonjour,

EDIT : J'ai trouvé l'erreur.

Super.
Tu pourrais en faire profiter la communauté et publier ton code ainsi corrigé. C'est cela aussi l'esprit du forum.
N'oublie pas non plus de cocher le bouton

**BaelBender** · 30/05/2014, 14h33

L'erreur était dans le End if inexistant, et que j'avais mal replacé avant de me rendre compte de mon erreur. Le code corrigé est le suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub UserForm_Initialize()
Dim Num%, txt%
Dim SheetData() As String
Dim ShtNum As Integer
Dim ShtCnt As Integer
Dim sht As Worksheet
Dim LisPost As Integer
 
Set OriginalSheet = ActiveSheet
ShtCnt = ActiveWorkbook.Sheets.Count
ReDim SheetData(1 To ShtCnt, 1 To 4)
 ShtNum = 1

For Each sht In ActiveWorkbook.Sheets
   If Left(sht.Name, 1) = "1" Then
    LisPost = ShtNum - 1
SheetData(ShtNum, 1) = sht.Name
Select Case TypeName(sht)
    Case "WorkSheet"
    SheetData(ShtNum, 2) = "Feuil"
    SheetData(ShtNum, 3) = Application.CountA(sht.Cells)
End Select
   ShtNum = ShtNum + 1
   End If
    Next sht
With ComboBox1
    .ColumnWidths = "30 pt;30 pt; 40 pt;50 pt"
    .List = SheetData
    .ListIndex = LisPost
End With
End Sub

Encore merci

**Philippe Tulliez** · 30/05/2014, 14h46

Bonjour,
Essaye de placer le code entre les balises prévues à cet effet (bouton avec le croisillon #"
Petite remarque sur cette ligne de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each sht In ActiveWorkbook.Sheets

Sauf si c'est voulu ActiveWorkbook est le classeur actif. C'est à dire que si par hasard, tu enclenches le code qui se trouverait sur le classeur nommé Classeur2 alors que le Classeur1 est actif, c'est celui-ci qui aura la liste déroulante et le nom des feuilles également.
Pour faire en sorte que ce soit le classeur dans lequel le code se trouve, il faut utiliser ThisWorkbook