Discussion :

[Rapidkiller]

Bonjour,

Je cherche en vain depuis plusieurs jours à réaliser mon projet et je sèche sur la partie la plus basique ... remettre à zéro les ComboBox & dropDown de mon ruban.

La première liste qui fonctionne sans problème mais qui reste sur le choix sélectionné (en dur dans le XML car le classeur contient ses feuilles dès le départ)

De ce fait, si on choisit dans la liste, la feuille Aide, que l'on change d'onglet et que l'on souhaite de nouveau accèder à la feuille Aide, il faut changer deux fois la liste Go to (une première fois pour quitter le choix Aide, et une seconde fois pour y retourner). J'aimerai du coup, remettre le choix à zéro une fois l'action ChangeCB1 réalisée.

La seconde liste est dynamique car elle ne doit lister que les feuilles visibles de personnes (prénom nom -> qui contiennent donc toujours un espace)
Là encore, le choix réalisé reste actif (attention, je débute en VBA et XML donc c'est de la bidouille pour commencer le listing à la feuille 4 (3 visibles + 1 cachée)).

Par ailleurs, impossible de faire fonctionner vba invalidateContentOnDrop="true" dans mon xml sous peine d'invalider l'onglet en question. Du coup, quand j'ajoute une personne à mon classeur, via une macro séparée ou en ajoutant manuellement la feuille, la liste des personnes ne s'actualise pas, à mon grand désarroi

A noter que mon classeur contient également une feuille cachée que je ne souhaite pas lister.

Ci-dessous le code des deux listes (celle qui est dynamique [ListePersonne] et l'autre codée en dur [CB1])

XML

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
<group id="GR1" label="Navigation">
				<comboBox id="CB1" label="Go to" onChange="ChangeCB1" > 
				<item id="it1" label="Sommaire" imageMso="AccessTableContacts" /> 
				<item id="it2" label="Synthèse" imageMso="ChartPlotArea" /> 
				<item id="it3" label="Aide" imageMso="Help" /> 
				</comboBox>
				<dropDown 
                        id="ListePersonne"
                        label="Nom complet"
                        sizeString="WWWWWWWWWWWW"
                        supertip="Permet d'aller directement à la feuille sélectionnée dans la liste déroulante !"
                        getItemCount="ItemCount"
                        getItemLabel="ListItem"
			getVisible="TesteCondition"
                        onAction="Item_Selected" />
			</group>

VBA

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
32
33
 
Option Explicit
 
Sub ItemCount(control As IRibbonControl, ByRef returnedVal)
    Dim lCount As Long
    Dim wksSheet As Worksheet
    'Set mwkbNavigation = ThisWorkbook
    For Each wksSheet In ThisWorkbook.Worksheets
        If wksSheet.Visible = xlSheetVisible And wksSheet.Name Like "* *" Then
            lCount = lCount + 1
        End If
    Next wksSheet
    returnedVal = lCount
End Sub
Sub ListItem(control As IRibbonControl, index As Integer, ByRef returnedVal)
    If ThisWorkbook.Worksheets(index + 1).Visible = xlSheetVisible Then
        returnedVal = ThisWorkbook.Worksheets(index + 4).Name
    End If
End Sub
 
Sub Item_Selected(control As IRibbonControl, label As String, index As Integer)
        Sheets(ThisWorkbook.Worksheets(index + 4).Name).Select
End Sub
 
 
'N'affiche pas la liste des personnes si le nombre d'onglets est inférieur à 4
Sub TesteCondition(control As IRibbonControl, ByRef returnedVal)
    returnedVal = ThisWorkbook.Sheets.Count > 4
End Sub
 
Sub ChangeCB1(control As IRibbonControl, text As String)
    Sheets(text).Activate
End Sub

Depuis le temps que je galère avec différents tests : combobox, dropDown, ... je m'en remets aux dieux du XML et VBA pour m'aider à corriger mes quelques problèmes

Merci

[mjpmjp]

bonjour,
excel 2010/2016, j'ai eu un petit souci avec les nom d'onglet avec espace,
si un seul avait un espace, la liste restait vide, et quand je modifiais avec un "_" la liste fonctionnait correctement !!!???

je trouve le code et je reviens..

@+JP

[mjpmjp]

bonjour,
avec 2016, un click droit entre les flèches et tu as ta navigation avec les espaces !!!

@+JP

[mjpmjp]

bonjour,
capture du bouton et de la liste :

@+JP

[mjpmjp]

bonjour,
pour le code VBA

dans ThisWorkbook :

Code :

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

1
2
3
4
 
Private Sub Workbook_Open()
    Call InitMenuRuban
End Sub

dans un module (SYSTEM_Menu_Ribbon):

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
32
33
34
35
36
37
38
39
40
41
42
 
Public objRuban As IRibbonUI
Public Ribbon As IRibbonUI
Public NewLabel_List As String
Public boolResult As Boolean
Public boolResult_15 As Boolean
 
'**********************************************************************************
'Callback for customUI.onLoad
Sub OnLoadRubanCharge(Ribbon As IRibbonUI)
    Set objRuban = Ribbon
    Call InitMenuRuban
End Sub
 
 
Sub InitMenuRuban()
    'Rafraichit le Menu RUBAN
    boolResult = True
    boolResult_15 = True: If Not objRuban Is Nothing Then objRuban.InvalidateControl "ListDynamique"
End Sub
'#################################################################################ListDynamique
'Callback for ListDynamique getContent
Public Sub CreationMenuDynamique(control As IRibbonControl, ByRef returnedVal)
    'ouverture de la balise menu
    returnedVal = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"" itemSize=""normal"">"
    'List les feuilles de calcul du classeur actif
    returnedVal = returnedVal & ListFeuilles(ActiveWorkbook)
    'fermeture de la balise
    returnedVal = returnedVal & "</menu>"
End Sub
 
 
'Callback for ListDynamique getEnabled
Sub ListDynamique_Enabled(control As IRibbonControl, ByRef returnedVal)
    returnedVal = boolResult_15
End Sub
 
 
Public Sub ActivationFeuille(control As IRibbonControl)
    'Active la feuille sélectionnée lorsque vous cliquez sur un nom dans le menu.
    Sheets(control.Tag).Activate
End Sub

dans un module (SYSTEM_Menu_Fonction):

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
 
 
'#################################################################################ListDynamique
Public Function ListFeuilles(Wb As Workbook) As String
    Dim strTemp As String
    Dim Ws As Worksheet
    ' Insertion d'un titre de menu
    strTemp = "<menuSeparator id=""Feuilles"" title=""Feuilles""/>"
    ' ajoute un bouton dans le menu pour chaque feuille du classeur
    For Each Ws In Wb.Worksheets
    strTemp = strTemp & _
    "<button " & _
    CreationAttribut("id", "Bt" & Ws.Name) & " " & _
    CreationAttribut("label", Ws.Name) & " " & _
    CreationAttribut("tag", Ws.Name) & " " & _
    CreationAttribut("onAction", "ActivationFeuille") & "/>"
    Next
    ListFeuilles = strTemp
End Function
 
 
Public Function CreationAttribut(strAttribut As String, Donnee As String) As String
    CreationAttribut = strAttribut & "=" & Chr(34) & Donnee & Chr(34)
End Function

à suivre le code xml..
@+JP

[mjpmjp]

bonjour,
pour éditer la partie xml, j'utilise "OfficeCustomUIEditorSetup_2007-2010"

pour la partie "insert image"


l'image qui du bouton est : Onglet_Selection
j'ai créé cette image avec paint et modifié l'ombre avec un logiciel icone

pour le code xml

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="OnLoadRubanCharge"> 
<ribbon startFromScratch="false">
<tabs>
 
<group id="GrpWORK" label="WORK">
	<dynamicMenu id="ListDynamique" label="Onglet" getEnabled="ListDynamique_Enabled"  getContent="CreationMenuDynamique" invalidateContentOnDrop="true" size="large" image="Onglet_Selection" screentip=" " supertip=" " tag=" " />
</group>
 
</tab>
</tabs>
</ribbon>
</customUI>

@+JP

[Rapidkiller]

Bonjour mjpmjp

Merci pour la réponse. J'avais déjà testé ce code qui fonctionne parfaitement.
Je l'avais d'ailleurs adapté pour afficher les feuilles sans les _ mais que la redirection fonctionne quand même à l'aide du code suivant

Code :

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

1
2
3
4
5
6
7
8
9
 
For Each Ws In Wb.Worksheets
        strTemp = strTemp & _
            "<button " & _
            CreationAttribut("id", "Bt" & Replace(Ws.Name, " ", "_")) & " " & _
            CreationAttribut("label", Ws.Name) & " " & _
            CreationAttribut("tag", Ws.Name) & " " & _
            CreationAttribut("onAction", "ActivationFeuille") & "/>"
Next

Malheureusement j'ai opté pour les combobox car on peut trouver le nom d'une feuille en commençant la saisie de celle-ci (un peu comme avec le choix des polices) et vu que mon classeur est destiné à accueillir plus de 200 noms ... je voulais simplifier la navigation au maximum et ainsi éviter le scroll à outrance.

Si vous voyez d'autres pistes, n'hésitez pas, plusieurs cerveaux valent mieux qu'un

[mjpmjp]

bonjour,
pour les combo et callback, j'ai cette doc :
La fonction CallBack associée à l'attribut onChange, à placer dans un module standard du classeur:

Vba

Code :

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

1
2
3
4
5
 
'Callback for CB1 onChange 
Sub ChangeCB1(control As IRibbonControl, text As String)
    MsgBox text 
End Sub

Le code xml suivant gère l'alimentation de la liste déroulante par VBA. Il permet d'afficher les données contenues dans colonne A de la Feuil1, dans le comboBox. Le rappel getItemCount définit le nombre d'items à afficher dans le contrôle. L'attribut invalidateContentOnDrop actualise automatiquement le contenu du contrôle lorsque celui-ci est sélectionné.

Xml

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
 
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" > 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="OngletPerso" label="OngletPerso" visible="true">
   <group id="Projet01" label="Projet 01">
      <!-- getItemCount="NbItemCombo" va définir le nombre d'items dans la combobox. -->
       <!-- getItemLabel="ComboLabel" permet d'alimenter la combobox. -->
      <!-- invalidateContentOnDrop="true" permet la mise à jour automatique du contrôle. -->
      <comboBox id="Combo1" label="Choix : " getItemCount="NbItemCombo" getItemLabel="ComboLabel" invalidateContentOnDrop="true" />
   </group> 
</tab> 
</tabs> 
</ribbon> 
</customUI>

Les fonctions de rappel associées au code xml, à placer dans un module standard du classeur :

vba

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
 
'Callback for Combo1 getItemCount 
Sub NbItemCombo(control As IRibbonControl, ByRef returnedVal)
    'Définit le nombre d'éléments dans la combobox
    'Récupère le nombre de données dans la colonne A.
    returnedVal = Feuil1.Range("A65536").End(xlUp).Row 
End Sub
 
'Callback for Combo1 getItemLabel 
'Index est défini par la valeur saisie dans la fonction de rappel NbItemCombo 
Sub ComboLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
        If Feuil1.Range("A65536").End(xlUp).Row = 0 Then Exit Sub
        'Alimente le Combobox à partir des données de la plage de cellules
        returnedVal = Feuil1.Cells(index + 1, 1) 
End Sub

@+JP

[Rapidkiller]

Testé aussi
Ici les noms de la liste déroulante sont récupérés depuis la feuille1 en colonne A ...
J'aimerai si possible me passer de la création de cette liste

[mjpmjp]

bonjour,
bon..ok...j'ai compris, il va falloir que je me mette au travail

@+JP

[mjpmjp]

bonjour,

résultat


dans ThisWorkbook (pour exemple)

Code :

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

1
2
3
Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Call ListOnglet
End Sub

dans module (SYSTEM_Menu_Ribbon)

Code :

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

1
2
3
4
5
6
7
8
Public objRuban As IRibbonUI
Public Ribbon As IRibbonUI
 
'******************************************
'Callback for customUI.onLoad
Sub OnLoadRubanCharge(Ribbon As IRibbonUI)
    Set objRuban = Ribbon
End Sub

dans module (SYSTEM_Menu_Fonction)

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
Dim TabOnglet() As String
 
'Callback for Combo1 getItemCount
Sub NbItemCombo(control As IRibbonControl, ByRef returnedVal)
    'Définit le nombre d'éléments dans la combobox
    returnedVal = UBound(TabOnglet)
End Sub
 
'Callback for Combo1 getItemLabel
'Index est défini par la valeur saisie dans la fonction de rappel NbItemCombo
Sub ComboLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
        'Alimente le Combobox à partir des données de la plage de cellules
        returnedVal = TabOnglet(index + 1)
End Sub
 
Public Sub ListOnglet()
    ReDim TabOnglet(Sheets.Count)
    For i = 1 To Sheets.Count
        TabOnglet(i) = Sheets(i).Name
    Next
End Sub

dans code xlm

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" > 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="OngletPerso" label="OngletPerso" visible="true">
   <group id="Projet01" label="Projet 01">
      <!-- getItemCount="NbItemCombo" va définir le nombre d'items dans la combobox. -->
       <!-- getItemLabel="ComboLabel" permet d'alimenter la combobox. -->
      <!-- invalidateContentOnDrop="true" permet la mise à jour automatique du contrôle. -->
      <comboBox id="Combo1" label="Choix : " getItemCount="NbItemCombo" getItemLabel="ComboLabel" invalidateContentOnDrop="true" />
   </group> 
</tab> 
</tabs> 
</ribbon> 
</customUI>

@+JP

[Rapidkiller]

Merci pour vos réponses.

Alors mes remarques dans l'ordre

La liste ne fonctionne qu'à partir de 2 feuilles, sinon elle plante sur la procédure NbItemCombo avec un bon vieux l'indice n'appartient pas à la sélection.
Problème résolu à l'ajout d'une feuille

Par contre toujours ce souci de rafraichissement quand j'ai sélectionné un item dans la liste, il reste

De plus comment puis je écarter des feuilles de la liste pour ne lister que celles qui contiennent des espaces ?
J'ai bien mis :

Code :

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

1
2
3
4
5
6
Public Sub ListOnglet()
    ReDim TabOnglet(Sheets.Count)
    For i = 1 To Sheets.Count
        If Sheets(i).Name Like "* *" Then TabOnglet(i) = Sheets(i).Name
    Next
End Sub

Mais je garde le nombre d'items égal au nombre total de feuilles, du coup, j'ai des lignes vides dans la liste (sans parler de l'erreur si je clique sur un item vide)

[mjpmjp]

bonjour,

La liste ne fonctionne qu'à partir de 2 feuilles, sinon elle plante sur la procédure NbItemCombo avec un bon vieux l'indice n'appartient pas à la sélection.
Problème résolu à l'ajout d'une feuille

ajouter Call ListOnglet

Code :

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

1
2
3
4
5
6
'Callback for Combo1 getItemCount
Sub NbItemCombo(control As IRibbonControl, ByRef returnedVal)
    Call ListOnglet
    'Définit le nombre d'éléments dans la combobox
    returnedVal = UBound(TabOnglet)
End Sub

pour que TabOnglet corresponde au nombre d'onglet
@+JP

[mjpmjp]

bonjour,
pour l'ensemble des modifs:

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
32
33
34
35
'Dim TabOnglet() As String 'pour liste complette
Dim TabSansEspace() As String
 
'Callback for Combo1 getItemCount
Sub NbItemCombo(control As IRibbonControl, ByRef returnedVal)
    Call ListOnglet
    'Définit le nombre d'éléments dans la combobox
    'returnedVal = UBound(TabOnglet) 'pour liste complette
    returnedVal = UBound(TabSansEspace)
End Sub
 
'Callback for Combo1 getItemLabel
'Index est défini par la valeur saisie dans la fonction de rappel NbItemCombo
Sub ComboLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
        'Alimente le Combobox à partir des données de la plage de cellules
        'returnedVal = TabOnglet(index + 1) 'pour liste complette
        returnedVal = TabSansEspace(index + 1)
End Sub
 
Public Sub ListOnglet()
    '----- efface le contenu (redim:indirectement)
    'ReDim TabOnglet(Sheets.Count) 'pour liste complette
    ReDim TabSansEspace(1)
    '----- boucle de tous les onglets
    For i = 1 To Sheets.Count
        'TabOnglet(i) = Sheets(i).Name 'pour liste complette
        '----- filtre (si " ")
        If Sheets(i).Name Like "* *" Then
            'écrit le nom de l'onglet (contenant " ")
            TabSansEspace(UBound(TabSansEspace)) = Sheets(i).Name
            'si pas le dernier onglet alors agrandir le Tableau en "Preservant" le contenu
            If i < Sheets.Count Then ReDim Preserve TabSansEspace(UBound(TabSansEspace) + 1)
        End If
    Next
End Sub

@+JP

[Rapidkiller]

Merci, ca avance bien

Du coup, j'ai ajouté l'appel de la fonction dans le changement de feuilles, l'ouverture du classeur et la création d'une nouvelle feuille afin d'avoir toujours une liste à jour

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Workbook_Open()
    Call ListOnglet
End Sub
 
Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Call ListOnglet
End Sub
 
 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call ListOnglet
End Sub

Ca fonctionne parfaitement.
J'ai aussi modifié ListOnglet pour ne lister que les feuilles avec des espaces et ça semble fonctionner

Code :

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

1
2
3
4
5
6
7
8
9
10
Public Sub ListOnglet()
    On Error Resume Next
    ReDim TabOnglet(Sheets.Count - 4)
    For i = 1 To Sheets.Count
        If Sheets(i).Name Like "* *" Then
            a = a + 1
            TabOnglet(a) = Sheets(i).Name
        End If
    Next
End Sub

Dernier souci, la remise à zéro de la liste déroulante ... si jamais une idée vous vient, je suis preneur

[mjpmjp]

bonjour,
attention, la version précédente avait un bug (ligne vide dans certain cas)

voici la dernière version (inspirée par ton a=a+1 )

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
 
Public Sub ListOnglet()
    '----- efface le contenu (redim:indirectement)
    'ReDim TabOnglet(Sheets.Count) 'pour liste complette
    ReDim TabSansEspace(1)
    'compte le nombre d'onglet sans espace
    NbOngletSansEspace = 0
    '----- boucle de tous les onglets
    For i = 1 To Sheets.Count
        'TabOnglet(i) = Sheets(i).Name 'pour liste complette
        '----- filtre (si " ")
        If Sheets(i).Name Like "* *" Then
            'si au moins 1 onglet sans espace a été "enregistré"
            'alors agrandir le Tableau en "Preservant" le contenu
            If NbOngletSansEspace > 0 Then ReDim Preserve TabSansEspace(UBound(TabSansEspace) + 1)
                'compte le nombre d'onglet sans espace
                NbOngletSansEspace = NbOngletSansEspace + 1
                'écrit le nom de l'onglet (contenant " ")
                TabSansEspace(NbOngletSansEspace) = Sheets(i).Name
        End If
    Next
End Sub

@+JP

[mjpmjp]

bonjour,
pour la mise à zero :

dans module (portée module)

Code :

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

1
2
3
'Dim TabOnglet() As String 'pour liste complette
Dim TabSansEspace() As String
Dim MiseZero As Boolean

dans ListOnglet...A SUPRIMER APRES TEST

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
 
Public Sub ListOnglet()
    '****UNIQUEMENT POUR TEST*****
    '** A SUPRIMER ***************
    '* choisir une des 2 lignes
    '* mettre l'autre en commentaire
    'MiseZero = True
    MiseZero = False
    '** A SUPRIMER jusqu'à cette ligne ***
 
    '----- efface le contenu (redim:indirectement)
    'ReDim TabOnglet(Sheets.Count) 'pour liste complette
    ReDim TabSansEspace(1)
    'compte le nombre d'onglet sans espace
    NbOngletSansEspace = 0
    '----- boucle de tous les onglets
    For i = 1 To Sheets.Count
        'TabOnglet(i) = Sheets(i).Name 'pour liste complette
        '----- filtre (si " ")
        If Sheets(i).Name Like "* *" Then
            'si au moins 1 onglet sans espace a été "enregistré"
            'alors agrandir le Tableau en "Preservant" le contenu
            If NbOngletSansEspace > 0 Then ReDim Preserve TabSansEspace(UBound(TabSansEspace) + 1)
                'compte le nombre d'onglet sans espace
                NbOngletSansEspace = NbOngletSansEspace + 1
                'écrit le nom de l'onglet (contenant " ")
                TabSansEspace(NbOngletSansEspace) = Sheets(i).Name
        End If
    Next
End Sub

et le code de mise à zero dans NbItemCombo

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
'Callback for Combo1 getItemCount
Sub NbItemCombo(control As IRibbonControl, ByRef returnedVal)
    Call ListOnglet
    'Définit le nombre d'éléments dans la combobox
    'returnedVal = UBound(TabOnglet) 'pour liste complette
    If MiseZero Then
        returnedVal = 0
        MizeZero = False
    Else
        returnedVal = UBound(TabSansEspace)
    End If
End Sub

@+JP

[Rapidkiller]

Un vrai chef !!!

Je laisse ouvert le temps de tester un peu la bête mais je pense que ce topic va passer en résolu bientôt ;=)

Merci mjpmjp