XL 2019 Menu dynamique

[ADS95]

Bonjour à tous,

Je sèche sur le problème suivant :
Dans un tableau j'ai ajouté un menu dynamique qui fonctionne très bien lors de la création de nouveaux onglets.
Toutefois, je souhaiterai figer une couleur sur certains boutons pour par exemple Menu reste rouge et Base jaune.
J'ai essayé plusieurs méthodes sans succès.
Fichier joint.
Merci d'avance pour votre aide

 

[Bernard_XLD]

Bonjour ADS95, le forum

ajoutez une ligne de code pour colorier spécifiquement le bouton Menu ou le bouton base.

If bouton.TextFrame2.TextRange.Characters.Text = "Menu" Then bouton.OLEFormat.Object.Interior.Color = 255

votre code avec cette modification pour le menu

Sub sommaireDynamique()

    Dim feuille As Worksheet
    Dim bouton As Shape
    Dim positionY As Integer

    For Each bouton In ActiveSheet.Shapes
        If bouton.Name Like "menu_*" Then
            bouton.Delete
        End If
    Next

    positionY = 4

    For Each feuille In Worksheets

        Set bouton = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 4, positionY, [a1].Width - 8, 30)

        bouton.TextFrame2.TextRange.Characters.Text = feuille.Name

        If feuille.Name = ActiveSheet.Name Then
            bouton.ShapeStyle = msoShapeStylePreset14
        Else
            bouton.ShapeStyle = msoShapeStylePreset13
        End If
        If bouton.TextFrame2.TextRange.Characters.Text = "Menu" Then bouton.OLEFormat.Object.Interior.Color = 255
        feuille.Hyperlinks.Add Anchor:=bouton, Address:="", SubAddress:="'" & feuille.Name & "'!A1"
        bouton.Name = "menu_" & feuille.Name

        positionY = positionY + 30
    Next
End Sub

Bien cordialement, @+

 

[ADS95]

Bonjour Bernard_XLD,

Merci beaucoup super, j'ai ajouté le code suivant pour laisser en vert quand l'onglet spécifique couleur est actif.

If feuille.Name = ActiveSheet.Name Then
bouton.ShapeStyle = msoShapeStylePreset14
Else
If bouton.TextFrame2.TextRange.Characters.Text = "Menu" Then bouton.OLEFormat.Object.Interior.Color = RGB(224, 0, 224)
End If

​