Discussion :

[seb1kl]

Bonjour,

Apres avoir lu le tutoriel de SilkyRoad sur la personnalisation du ruban sous excel 2007
http://silkyroad.developpez.com/excel/ruban/#LIII-F-13

J'ai decouvert un example de code pour effectuer un menu deroulant dynamique listant les differents feuilles du fichier actif. Cette liste est automatiquement mise a jour lors de la creation/suppression ou mise a jour du titre des feuilles.

Pourriez-vous m'aider a adapter le code pour realiser le meme principe mais en listant les valeurs d'une range de cellules definie par un nom specifique (ex:projectlist)?

Voici le code original:

Code XML via CustomUI editor:

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
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
 
    <tabs>
        <tab id="Ongletperso" label="Liste feuilles">
 
            <group id="GR01" label="Test">
 
            <dynamicMenu id="ListeDynamique"
                label="Liste feuilles"
                getContent="CreationMenuDynamique"
                invalidateContentOnDrop="true"
                size="normal"
                imageMso="PrintTitles"/>
            </group>
 
        </tab>
    </tabs>
 
</ribbon>
</customUI>

Voici le code VBA inserer dans un module standard:

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
 
'Callback for ListeDynamique getContent
'Procédure pour construire le menu dynamique
Public Sub CreationMenuDynamique(ctl As IRibbonControl, ByRef content)
    'ouverture de la balise menu
    content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">"
 
    'liste les feuilles de calcul du classeur actif
    content = content & ListeFeuilles(ActiveWorkbook)
 
    'liste les feuilles graphiques du classeur actif
    content = content & ListeCharts(ActiveWorkbook)
 
    'fermeture de la balise
    content = content & "</menu>"
End Sub
 
 
 
Private Function ListeFeuilles(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
 
    ListeFeuilles = strTemp
End Function
 
 
'Liste les feuilles graphiques contenues dans le classeur
Private Function ListeCharts(Wb As Workbook) As String
    Dim strTemp As String
    Dim Ch As Chart
 
    If Wb.Charts.Count = 0 Then Exit Function
 
    strTemp = "<menuSeparator id=""charts"" title=""charts""/>"
 
    For Each Ch In Wb.Charts
        strTemp = strTemp & _
            "<button " & _
            CreationAttribut("id", "Bt" & Ch.Name) & " " & _
            CreationAttribut("label", Ch.Name) & " " & _
            CreationAttribut("tag", Ch.Name) & " " & _
            CreationAttribut("onAction", "ActivationFeuille") & "/>"
    Next
 
    ListeCharts = strTemp
End Function
 
 
Function CreationAttribut(strAttribut As String, Donnee As String) As String
    CreationAttribut = strAttribut & "=" & Chr(34) & Donnee & Chr(34)
End Function
 
 
 
'Active la feuille sélectionnée lorsque vous cliquez sur un nom
'dans le menu.
Sub ActivationFeuille(control As IRibbonControl)
    Sheets(control.Tag).Activate
End Sub

Et voici le code que j'ai essaye d'adapter sur la fonction For each qui ne fonctionne malheureusement pas car la liste deroulante est vide:

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
Private Function ListeFeuilles(Wb As Workbook) As String
    Dim strTemp As String
    Dim Ws As Worksheet
    Dim myRange As Range
Dim cell As Range
    Set myRange = ActiveSheet.Range("projectlist")
 
    ' 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 cell In myRange.Cells
        strTemp = strTemp & _
            "<button " & _
            CreationAttribut("id", "Bt" & cell.Value) & " " & _
            CreationAttribut("label", cell.Value) & " " & _
            CreationAttribut("tag", cell.Value) & " " & _
            CreationAttribut("onAction", "ActivationFeuille") & "/>"
    Next
 
    ListeFeuilles = strTemp
End Function

Merci d'avance pour votre aide.
Cordialement,
sbkl

[seb1kl]

Ok.

Donc j'ai trouve la raison pour laquelle la liste est vide avec la boucle For Each que j'ai adapte.

En faite, J'ai des valeurs en plusieurs mots dans certaines cellules de ma liste.

Si j'efface les espaces entre les mots ou remplace par un "underscore" par exemple dans chacune des cellules de ma liste alors la liste apparait dans le menu deroulant de maniere dynamique.

Au cas ou, avez-vous une idee pour etre capable d'avoir des valeurs avec des espaces?

Pour info mon code final ajouter au code xml via CustomUI editor

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
Option Explicit
 
'Callback for ListeDynamique getContent
'Procédure pour construire le menu dynamique
Public Sub CreationMenuDynamique(ctl As IRibbonControl, ByRef content)
    'ouverture de la balise menu
    content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">"
 
    'liste les feuilles de calcul du classeur actif
    content = content & ProjectList(ActiveWorkbook)
 
    'fermeture de la balise
    content = content & "</menu>"
End Sub
Private Function ProjectList(Wb As Workbook) As String
    Dim strTemp As String
    Dim myRange As Range
    Dim cell As Range
 
    Set myRange = ActiveSheet.Range("PROJECT_LIST")
    ' Insertion d'un titre de menu
    strTemp = "<menuSeparator id=""Feuilles"" title=""A changer par une valeur de cellule""/>"
 
For Each cell In myRange
        strTemp = strTemp & _
            "<button " & _
            CreationAttribut("id", "Bt" & cell.Value) & " " & _
            CreationAttribut("label", cell.Value) & " " & _
            CreationAttribut("tag", cell.Value) & " " & _
            CreationAttribut("onAction", "ActivationFeuille") & "/>"
Next cell
    ProjectList = strTemp
End Function
Function CreationAttribut(strAttribut As String, Donnee As String) As String
    CreationAttribut = strAttribut & "=" & Chr(34) & Donnee & Chr(34)
End Function
'Insert the value of the menu into a cell when you click
Sub ActivationFeuille(control As IRibbonControl)
Range("B2").Value = control.Tag
End Sub

Maintenant je souhaiterais changer le titre "A changer par une valeur de cellule" par la valeure d'une cellule donnee.

Avez-vous une idee?

Merci
Cordialement,
Sebastien

[PMO2017]

Bonjour,

Essayez de changer la procédure ProjectList par le code suivant dans lequel les ajouts et modification sont signalés par des ///

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
Private Function ProjectList(Wb As Workbook) As String
    Dim strTemp As String
    Dim myRange As Range
    Dim cell As Range
 
    Set myRange = ActiveSheet.Range("PROJECT_LIST")
 
Dim MonTitre$                         '///ajout
MonTitre$ = ActiveSheet.Range("a1")   '///ajout
    ' Insertion d'un titre de menu
    strTemp = "<menuSeparator id=""Feuilles"" title=""" & MonTitre$ & """/>"  '///modification (variable titre)
 
For Each cell In myRange
 
Dim SansSpace$                        '///ajout
SansSpace$ = Replace(cell, " ", "_")  '///ajout
'/// puis modification sur cette ligne de code CreationAttribut("id", "Bt" & SansSpace$) & " " &
 
        strTemp = strTemp & _
            "<button " & _
            CreationAttribut("id", "Bt" & SansSpace$) & " " & _
            CreationAttribut("label", cell.Value) & " " & _
            CreationAttribut("tag", cell.Value) & " " & _
            CreationAttribut("onAction", "ActivationFeuille") & "/>"
Next cell
    ProjectList = strTemp
 
End Function

[seb1kl]

Ces chagements pour permettre d'avoir des valeurs avec espaces et changer le sous-menu via une cellule fonctionnent parfaitement.

Merci!

Cordialement,
sbkl