Microsoft 365 Menu dynamique Excel

ADS95

XLDnaute Nouveau
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

XLDnaute Barbatruc
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
VB:
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

XLDnaute Nouveau
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
VB:
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
 

ADS95

XLDnaute Nouveau
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
 

Pièces jointes

  • Classeur1.xlsx
    17.3 KB · Affichages: 20

patricktoulon

XLDnaute Barbatruc
re
ben dans ce cas là tu reprends mon code et tu supprime la condition
VB:
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

XLDnaute Nouveau
re
ben dans ce cas là tu reprends mon code et tu supprime la condition
VB:
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

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

VB:
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

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

VB:
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
 

Discussions similaires

Réponses
1
Affichages
119