affecter un lien hypertexte à un bouton sur une feuille : vba excel

kuistau

XLDnaute Nouveau
bonjour à toutes et tous
j'ai dans un classeur de gestion de stock un certain nombre de feuilles, chaque feuille, un fournisseur. j 'ai en première feuille un tableau de bord avec des boutons reliés un à un aux fournisseurs donc feuille, j'ai fait cette manip à la main. j'ai réussi via un bouton(code vba) à créer une nouvelle feuille fournisseur à modifier l'onglet qui porte le nom du fournisseur, à choisir un bouton libre sur mon tableau de bord à lui donner le nom du fournisseur et là blocage : je voudrais affecter un lien pour que, au clic sur le bouton il ouvre la feuille du fournisseur en question.
VB:
Sub copiefournisseur()

' nouveaufournisseur
Dim nomfour As String
Dim l As Integer
Dim link As String

    Sheets("fournisseur").Visible = True
    Sheets("fournisseur").Select
    Sheets("fournisseur").Copy After:=Sheets(Sheets.Count)
    Sheets("fournisseur").Visible = False
    Sheets("fournisseur (2)").Select
    nomfour = InputBox("entrez le nom du fournisseur : ")
  
  
If nomfour = "" Then
        MsgBox "sans nom, la fiche fournisseur sera éffacé"
       Sheets("fournisseur2").Delete
      
    Exit Sub
Else

    Sheets("fournisseur (2)").Name = nomfour
    Range("a1") = nomfour
    l = Sheets("bd").Range("a65536").End(xlUp).Row + 1
    Sheets("bd").Range("a" & l).Value = nomfour
    Sheets("tableau de bord").Activate
    link = "tableau de bord.xlsm - " & nomfour & "! -"
End If

    btn = InputBox("entrez le numero du bouton à utilser ?")
  
If btn = "" Then
    MsgBox " sans nombre la liaison ne pourra pas se faire"
  
    Exit Sub

End If

    If IsNumeric(btn) Then
  
With ActiveSheet.Shapes.Range(Array("btnf" & btn)).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.text = nomfour
    ActiveSheet.Hyperlinks.add Anchor:=Selection.ShapeRange.Item(1), Address:=link, NewWindow:=True

End With
  
End If
  
End Sub

merci pour votre aide
kuistau
 
Dernière édition:

kuistau

XLDnaute Nouveau
bonjour
après plusieurs recherches sur la toile, j'ai trouvé une solution que je vous partage
j'utilise un "subaddress" ds nom code
VB:
ActiveSheet.Hyperlinks.add Anchor:=Selection.ShapeRange.Item(1), Address:="", SubAddress:="'" & nomfour & "'!A1", TextToDisplay:=nomfour
merci à tous et à bientôt
kuistau
 

Discussions similaires

Statistiques des forums

Discussions
314 719
Messages
2 112 181
Membres
111 452
dernier inscrit
christine64