creation de lien hypertext par macro

sunguess

XLDnaute Junior
Bonjour,

Je souhaiterais créer une macro qui me crée automatiquement des liens hypertexts entre mes onglets.

Dans le fichier exemple, il faudrait que la macro scanne la plage de cellule B3:B8 de l'onglet Summary. Pour chaque valeur, elle regarde si un onglet à le même nom. si c'est le cas elle crée un lien hypertext avec la cellule A1 de l'onglet et dans l'onglet elle rajoute "Summary" en A1 et un lien hypertext sur l'onglet summary. Si il n'y a pas d'onglet avec le même nom elle efface la valeur de la cellule.

Exemple pour la cellule B3 : la valeur de B3 est A et il y a bien un onglet qui s'appelle A donc elle crée en B3 un lien hypertext vers la cellule A1 de l'onglet A et dans l'onglet A elle écrit "Summary" en A1 et crée un lien hypertext vers la cellule B3 de l'onglet Summary.

Exemple pour la cellule B4 : la valeur de B4 est D et il n'y a pas d'un onglet qui s'appelle D. La macro efface la valeur de B4.

Quelqu'un peut il m'aider ?

D'avance merci.
 

Pièces jointes

  • Exemple.xlsx
    9.6 KB · Affichages: 60
  • Exemple.xlsx
    9.6 KB · Affichages: 67
  • Exemple.xlsx
    9.6 KB · Affichages: 71

Vorens

XLDnaute Occasionnel
Re : creation de lien hypertext par macro

Yop,



J'ai pas trop le temps de faier la solution complète mais de faire une recherche sur cellule et remplacer le text n'est pas très difficil. Je pence que ton vrai problème est de savoir comment creer un lien avec VBA.

Voila la ligne de code qui peut te permetre de faire sa (a adapter a ton problème, actuellement sa prend la cellule selectionner et sa creer le lien hypetext"

Code:
ActiveCell.FormulaR1C1 = "Go A"
  
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "Exemple(1).xlsm#F!A1", TextToDisplay:="Go A"

Donc le lien est creer entre la cellule et l'onglet "A" Pour modifier l'adresse, tu créer le lien manuelement et tu recupére l'addresse du lien creer manuelement pour le copier la =>
Code:
Address:= _
        "Exemple(1).xlsm#F!A1",

Sur cette base, tu devrais pouvoir faire ton petit fichierrapidement et sans soufrance =)


Meilleures salutations
 

sunguess

XLDnaute Junior
Re : creation de lien hypertext par macro

merci pour ton aide mais creer un lien hypertext dans une marco ne me pose pas de problème.

Ce qui me pose problème :
  • Tester dans chaque cellule s'il y a un onglet ayant pour nom la valeur de la cellule
  • Mettre la valeur de cette cellule dans une variable
  • Passer à la ligne suivante

Sais'tu m'aider sur ces points ?
 

dionys0s

XLDnaute Impliqué
Re : creation de lien hypertext par macro

Bonjour le forum :cool:

dans un module lambda :

Code:
Sub Creer_Liens()

Dim Cellule As Range
Dim Feuille As Worksheet

For Each Cellule In Sheets("Summary").Range("B3:B8")
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name = Cellule Then 'tu crées le lien
    Next Feuille
Next Cellule

End Sub
 

dionys0s

XLDnaute Impliqué
Re : creation de lien hypertext par macro

Re le forum

avec la création du lien, ça donne ceci, et ça fonctionne chez moi.
Code:
Sub Creer_Liens()

Dim Cellule As Range
Dim Feuille As Worksheet

For Each Cellule In Sheets("Summary").Range("B3:B8")
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name = Cellule Then Sheets("Summary").Hyperlinks.Add Anchor:=Cellule, Address:="", SubAddress:=Cellule.Value & "!" & Cellule.Value & "1", TextToDisplay:=Cellule.Value
    Next Feuille
Next Cellule

End Sub
 

sunguess

XLDnaute Junior
Re : creation de lien hypertext par macro

merci pour ton aide dionys0s

Deux points supplémentaires:
  1. comment modifier la macro pour prendre en compte que les onglets ne s'appellent pas A,B,C... mais A.XLS, B.XLS, C.XLS... ?
  2. Comment creer le lien hypertexte en A1 dans les onglets A.xls, B.xls... qui pointe sur la feuille Summary ?
 

tototiti2008

XLDnaute Barbatruc
Re : creation de lien hypertext par macro

Bonjour à tous,

comme tu as déjà des propositions VBA, je te propose une solution formule pour les liens vers les feuilles

dans ton fichier exemple, feuille Summary en C3

Code:
=SI(ESTERREUR(INDIRECT("'"&B3&"'!A1"));"";LIEN_HYPERTEXTE("#'"&B3&"'!A1";"Lien"))

à recopier vers le bas
 

Fo_rum

XLDnaute Accro
Re : creation de lien hypertext par macro

Bonjour,

si tu tiens à tes liens, la suite ne convient pas;), sinon, une autre macro évènementielle à placer dans ThisWorkook,
Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Est As Boolean
  If Intersect(Target, Range("A1,B3:B8")) Is Nothing Then Exit Sub
  If Target.Address = "$A$1" Then
    Sheets("Summary").Activate
  Else
    For Each Sh In Sheets
      If Sh.Name <> "Summary" And Sh.Name = Target Then
        Sh.[A1] = "Summary"
        Est = True
        Sh.Activate
        Exit Sub
      End If
    Next
    If Est = False Then Target = ""
  End If
End Sub
Explications dans le fichier joint.
 

Pièces jointes

  • Aller_Feuille.xlsm
    22.3 KB · Affichages: 63

Vorens

XLDnaute Occasionnel
Re : creation de lien hypertext par macro

re,

1) Dans cette macro, la valeur de la cellule = le nom de l'onglet recherché donc dans la cellule tu met "A.XLS", un lien va être creer vers l'onglet du meme nom.

2) T'as dit que tu savais creer des liens avec VBA, sa coince ou ?
 

dionys0s

XLDnaute Impliqué
Re : creation de lien hypertext par macro

merci pour ton aide dionys0s

Deux points supplémentaires:
  1. comment modifier la macro pour prendre en compte que les onglets ne s'appellent pas A,B,C... mais A.XLS, B.XLS, C.XLS... ?
  2. Comment creer le lien hypertexte en A1 dans les onglets A.xls, B.xls... qui pointe sur la feuille Summary ?

1*
Code:
Sub Creer_Liens()

Dim Cellule As Range
Dim Feuille As Worksheet

For Each Cellule In Sheets("Summary").Range("B3:B8")
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name = Cellule & ".XLS" Then Sheets("Summary").Hyperlinks.Add Anchor:=Cellule, Address:="", SubAddress:=Cellule.Value & "!" & Cellule.Value & "1", TextToDisplay:=Cellule.Value
    Next Feuille
Next Cellule

End Sub

2* Clic droit sur la cellule A1 de l'onglet A ==> lien hypertexte ==> Onglet de gauche "Emplacement dans ce document" ==> Sélection de l'onglet
(oublie pas de modifier le "Texte à afficher" en haut de la fenêtre.
 

sunguess

XLDnaute Junior
Re : creation de lien hypertext par macro

merci à tous pour votre aide.

Grâce à vous j'arrive à creer les liens sur la feuille Summary. Reste plus que les liens à partir des autres feuilles mais je vais me débrouiller autrement.

Fo_rum ton script avait l'air pas mal mais je n'ai pas réussi à l'utiliser.
 

sunguess

XLDnaute Junior
Re : creation de lien hypertext par macro

dionys0s peux tu me donner un coup de main supplémentaire ?

Comment modifier ton code pour que lorsque la macro ne crée pas un lien hypertext elle supprime la valeur de la cellule ?

D'avance merci.

(cas de la cellule B4 avec pour valeur D)
 

dionys0s

XLDnaute Impliqué
Re : creation de lien hypertext par macro

Hello Sunguess

Code:
Sub Creer_Liens()

Dim Cellule As Range
Dim Feuille As Worksheet

For Each Cellule In Sheets("Summary").Range("B3:B8")
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name = Cellule & ".XLS" Then
            Sheets("Summary").Hyperlinks.Add Anchor:=Cellule, Address:="", SubAddress:=Cellule.Value & "!" & Cellule.Value & "1", TextToDisplay:=Cellule.Value
        Else
            Cellule.ClearContents
        End if
    Next Feuille
Next Cellule

End Sub

Tout ce que tu demandes est assez facile à faire avec l'enregistreur de macro et en lisant le code. Trouver ce que je te donne était largement à ta portée, je pense.
Glad to help though.

Good day !
 

sunguess

XLDnaute Junior
Re : creation de lien hypertext par macro

merci.

J'avais essayé ca :

Code:
Sub Creer_Liens3()

Dim Cellule As Range
Dim Feuille As Worksheet

For Each Cellule In Sheets("Summary").Range("B3:B8")
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name = Cellule Then Sheets("Summary").Hyperlinks.Add Anchor:=Cellule, Address:="", SubAddress:=Cellule.Value & "!" & Cellule.Value & "1", TextToDisplay:=Cellule.Value
    Next Feuille
Next Cellule

For Each Cellule In Sheets("Summary").Range("B3:B8")
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name <> Cellule Then Selection.ClearContents
    Next Feuille
Next Cellule

End Sub

Malheureusement sans succès ...
 

Discussions similaires

Statistiques des forums

Discussions
312 415
Messages
2 088 238
Membres
103 779
dernier inscrit
FrancoisB2