Aide macro pour ajouter des bouton lien

Bonjour à tous,

J'ai un fichier avec beaucoup d'onglet et pour faciliter la navigation j'ai créé un tableau de bord avec des boutons me permettant d'atteindre les différents onglets et ceci avec des macros et cela fonctionne bien.

Par contre je suis coincé pour la suite, je suis amené à faire des répétition des tests donc créer des onglets supplémentaires. Je copie donc un onglet je le renomme vide le données et voilà. Ou je suis coincé c'est donc pour créer un bouton supplémentaire dans le tableau de bord avec le nom du nouvel onglet.

J''espère avoir été clair dans ma demande. et je vous remercie déjà de votre aide

Bonjour dav25, le forum,

Pourquoi t’embêter avec des boutons ?

Voici un exemple avec une feuille SOMMAIRE et des liens hypertext....

La macro s'exécute à chaque activation de la feuille SOMMAIRE....si tu ajoutes où supprime un onglet, la mise à jour est effectuée.

Cordialement,

Bonjour xorsankukai, dav25,

Voici une proposition avec des boutons:

Le code:

Procédure principale:

Sub test()
Dim Feuille As Worksheet
Dim Forme As Shape
Dim nbCol As Integer, lig As Integer, col As Integer, dech As Integer, decv As Integer

nbCol = 4
lig = 1
col = 0
dech = 180
decv = 70

'check des formes à supprimer
For Each Forme In Feuil1.Shapes
    If Not feuilleExiste(Replace(Forme.Name, "lien_", "")) Then
        Forme.Delete
    End If
Next Forme

'ajout de forme et mouvement
For Each Feuille In ThisWorkbook.Worksheets
    If Not Feuille.Name = Feuil1.Name Then
        If Not formeExiste("lien_" & Feuille.Name) Then
            ajoutForme Feuille.Name
        End If

        Set Forme = Feuil1.Shapes("lien_" & Feuille.Name)

        'bouger la forme
        col = col + 1
        If col > nbCol Then
            col = 1
            lig = lig + 1
        End If

        bougeForme Forme, lig, col, dech, decv
    End If
Next Feuille
End Sub

Fonction qui teste si la feuille existe:

Function feuilleExiste(nomFeuille As String) As Boolean
Dim Feuille As Worksheet

On Error Resume Next
Set Feuille = ThisWorkbook.Worksheets(nomFeuille)
On Error GoTo 0

feuilleExiste = Not Feuille Is Nothing
End Function

Fonction qui teste si la forme existe:

Function formeExiste(nomForme As String) As Boolean
Dim Forme As Shape

On Error Resume Next
Set Forme = Feuil1.Shapes(nomForme)
On Error GoTo 0

formeExiste = Not Forme Is Nothing
End Function

Procédure d'ajout d'une forme et de création de lien hypertexte:

Sub ajoutForme(nomFeuille As String)
Dim Forme As Shape

Set Forme = Feuil1.Shapes.AddShape(msoShapeRectangle, 25, 25, 150.75, 46.5)
Forme.Name = "lien_" & nomFeuille

With Forme.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = -0.150000006
    .Transparency = 0
    .Solid
End With
With Forme.Line
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorText1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
End With
With Forme.TextFrame2.TextRange.Font.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorText1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
End With

Forme.TextFrame2.VerticalAnchor = msoAnchorMiddle
Forme.TextFrame2.HorizontalAnchor = msoAnchorCenter
Forme.TextFrame2.TextRange.Characters.Text = nomFeuille

With Forme.TextFrame2.TextRange.Font
    .NameComplexScript = "+mn-cs"
    .NameFarEast = "+mn-ea"
    .Fill.Visible = msoTrue
    .Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
    .Fill.ForeColor.TintAndShade = 0
    .Fill.ForeColor.Brightness = 0
    .Fill.Transparency = 0
    .Fill.Solid
    .Size = 11
    .Name = "+mn-lt"
End With

Feuil1.Hyperlinks.Add Forme, "", nomFeuille & "!A1"
End Sub

Procédure pour bouger la forme:

Sub bougeForme(Forme As Shape, lig As Integer, col As Integer, dech As Integer, decv As Integer)
Forme.Left = 25 + dech * (col - 1)
Forme.Top = 25 + decv * (lig - 1)
End Sub

Merci à vous 2 pour ces réponses

je vais tester tout cela

Bonne journée