Microsoft 365 Menu dynamique Excel

[ADS95]

Bonjour à tour,
J'ai récupéré sur le net une méthode de création menu dynamique sur Excel en VBA, code ci-dessous.
Cela fonctionne très bien, toutefois je souhaiterai uniquement avoir en menu que les feuilles non masquées.
En effet, dans l'exemple toutes feuilles incrémentes le menu, même masquées, feuil4 masquée.
J'ai essayé plusieurs codes sans succès.
Merci de votre aide

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

ActiveSheet.Hyperlinks.Add Anchor:=bouton, Address:="", SubAddress:="'" & feuille.Name & "'!A1"
bouton.Name = "menu_" & feuille.Name

positionY = positionY + 30
Next
End Sub

 

[patricktoulon]

bonjour
j'ai ajouté une condition pour que la sub créée ton menu uniquement en feuille1 a toi d'adapter le nom ou supprimer cette ligne si tu veux construire ton menu sur n'importe quelle feuille

Sub sommaireDynamique()

    Dim feuille As Worksheet, bouton As Shape, positionY&
    If ActiveSheet.Name <> "Feuil1" Then Exit Sub    'Adapter le nom de la feuille


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

    positionY = 4

    For Each feuille In Worksheets
        If feuille.Visible Then
            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

            ActiveSheet.Hyperlinks.Add Anchor:=bouton, Address:="", SubAddress:="'" & feuille.Name & "'!A1"
            bouton.Name = "menu_" & feuille.Name

            positionY = positionY + 30
        End If
    Next
End Sub

 

[ADS95]

bonjour
j'ai ajouté une condition pour que la sub créée ton menu uniquement en feuille1 a toi d'adapter le nom ou supprimer cette ligne si tu veux construire ton menu sur n'importe quelle feuille

Sub sommaireDynamique()

    Dim feuille As Worksheet, bouton As Shape, positionY&
    If ActiveSheet.Name <> "Feuil1" Then Exit Sub    'Adapter le nom de la feuille


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

    positionY = 4

    For Each feuille In Worksheets
        If feuille.Visible Then
            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

            ActiveSheet.Hyperlinks.Add Anchor:=bouton, Address:="", SubAddress:="'" & feuille.Name & "'!A1"
            bouton.Name = "menu_" & feuille.Name

            positionY = positionY + 30
        End If
    Next
End Sub

Merci Patricktoulon,

Mais en fait je souhaiterait que le menu soit reproduit sur toutes le feuilles et incrémenté de nouvelles, comme le code initial, mais uniquement en incrémentant que les feuilles non masquées.
Malheureusement je ne peux pas joindre le fichier car il est en xlsm.
Merci encore pour ton aide

 

[patricktoulon]

re les xlsm tu peux les envoyer au pire zip le
parce que là je te comprends pas
c'est quoi incrémenté de nouvelle ?????

 

[ADS95]

Fichier en xlsx joint, je n'arrive pas à télécharger en xlsm ni en zip, j'ai un message m'informant que mon fichier n'est pas au format autorisée.
Dans le fichier joint manque le code VBA, toutefois comme tu peux le voir, j'ai bien en colonne A de toute les feuilles un menu reprenant le nom de celles-ci. Mais la feuille 4 est masquée toutefois elle apparait dans le menu.
Désolé de ne pas avoir été plus claire au départ.
Merci de ton aide

 

[patricktoulon]

re
ben dans ce cas là tu reprends mon code et tu supprime la condition

Sub sommaireDynamique()

    Dim feuille As Worksheet, bouton As Shape, positionY&
       For Each bouton In ActiveSheet.Shapes
        If bouton.Name Like "menu_*" Then
            bouton.Delete
        End If
    Next
    positionY = 4
    For Each feuille In Worksheets
        If feuille.Visible Then
            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

            ActiveSheet.Hyperlinks.Add Anchor:=bouton, Address:="", SubAddress:="'" & feuille.Name & "'!A1"
            bouton.Name = "menu_" & feuille.Name

            positionY = positionY + 30
        End If
    Next
End Sub

c'est pas compliqué surtout que je te l'ai déjà dis

 

[ADS95]

re
ben dans ce cas là tu reprends mon code et tu supprime la condition

Sub sommaireDynamique()

    Dim feuille As Worksheet, bouton As Shape, positionY&
       For Each bouton In ActiveSheet.Shapes
        If bouton.Name Like "menu_*" Then
            bouton.Delete
        End If
    Next
    positionY = 4
    For Each feuille In Worksheets
        If feuille.Visible Then
            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

            ActiveSheet.Hyperlinks.Add Anchor:=bouton, Address:="", SubAddress:="'" & feuille.Name & "'!A1"
            bouton.Name = "menu_" & feuille.Name

            positionY = positionY + 30
        End If
    Next
End Sub

c'est pas compliqué surtout que je te l'ai déjà dis

Super Génial, je me suis focalisé sur la première condition que tu avais ajouté sans vérifier que tu avais également apporté d'autres modifications.
Merci encore.

 

[patricktoulon]

et pour te simplifier la vie
tu ajoute dans le module thisworkbook

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
sommaireDynamique
End Sub

des que tu passe d'une feuille a l'autre le menu est récrée et donc sans les feuille invisible

 

[ADS95]

et pour te simplifier la vie
tu ajoute dans le module thisworkbook

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
sommaireDynamique
End Sub

des que tu passe d'une feuille a l'autre le menu est récrée et donc sans les feuille invisible

Oui je l'avais déjà ajouté dans mon fichier XLSM.
Vraiment je beuguais sur la condition feuille visible, j'avais pourtant essayé pas mal de code.
Bravo encore