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