Excel ribbon - menu deroulant dynamique
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:
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:
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:
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