Accueil

 

Créer un lien avec une formule Liens vers des onglets Sommaire dynamique avec Lien_Hypertexte Liens feuille suivante/Précédente Création d'un lien en VBA Sommaire avec Maj automatique Suppression de liens hypertexte Collection des liens hypertextes Liens Vers Fichiers d'un répertoire Liste des liens hypertextes du classeur FollowHyperLink Choix d'un lien

Lien_Hypertexte HyperLink.Add

Créer un lien avec une formule

Lien_Hypertexte("[nomClasseur.xls]'nomOnglet'!cellule";"TexteAffiché)

Sur cet exemple, nous créons un lien vers Classeur1.Xls

=LIEN_HYPERTEXTE("[classeur1.xls]'feuil1'!A1";"Classeur1")

Sur cet exemple, nous créons un lien hypertexte conditionnel. L'hyperlien est crée si le produit
est en rupture de stock. HyperLienSi

=SI(B2<C2;LIEN_HYPERTEXTE("["&A2&".xls]";A2);"")

Lien vers une cellule du classeur Actif xxxx.xls

HyperlienDéroulant

Lien hypertexte vers une cellule (D1) de la feuille active.

=LIEN_HYPERTEXTE("#D1";"Go")

Lien conditionnel

=LIEN_HYPERTEXTE(SI(A1="ok";"#D1";"#D5");"Go")

Lien calculé

Si A2 contient LOULOU, le lien se fait vers Z2.

=LIEN_HYPERTEXTE("#Z"&EQUIV(A2;{"FIFI";"LOULOU";"RIRI"};0);"Go")

Lien vers une date variable

=LIEN_HYPERTEXTE("#" &ADRESSE(4;($A$2-$D$4+1)*3+1);A2)

LienHyperDate
Accès rapide

Lien vers une feuille du classeur actif

=LIEN_HYPERTEXTE("#Feuil2!A1";"Feuil2")

Lien hypertexte vers un classeur dans un sous-répertoire

=LIEN_HYPERTEXTE("[BD\paris.xls]'base'!a1";"TexteAffiché")

Pointe vers la première cellule vide de la colonne A

=LIEN_HYPERTEXTE("#feuil1!" &ADRESSE(NBVAL(A:A)+1;1);"Fin")

Crée des liens vers des cellules espacées de 5 en 5

Hyper lien cellule
Hyper lien cellule2

=LIEN_HYPERTEXTE("#b"&10+(LIGNE()-2)*5;DECALER($B$10;(LIGNE()-2)*5;0))

Création de email à partir d'un lien sous forme de texte

A1 contient dupont@hotmail.com sous forme de texte

=LIEN_HYPERTEXTE("mailto:"&A1)

Création de email à partir du nom et du prénom

En C2:=MINUSCULE(sansaccent(SUBSTITUE(A2;" ";"-")&"."&SUBSTITUE(B2;" ";"-") &"@edf.fr"))

En D2:=LIEN_HYPERTEXTE("mailto:"&MINUSCULE(sansaccent(SUBSTITUE(A2;" ";"-")&"."&SUBSTITUE(B2;" ";"-")) &"@edf.fr");MINUSCULE(sansaccent(SUBSTITUE(A2;" ";"-")&"."&SUBSTITUE(B2;" ";"-") &"@edf.fr")))

Email

Dans un module

Function sansAccent(chaine)
  codeA = "ÉÈÊËÔéèêëàçùôûïî"
  codeB = "EEEEOeeeeacuouii"
  temp = chaine
  For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
  Next
  sansAccent = temp
End Function

Crée un lien hypertexte vers un fichier si celui ci existe

A2 contient un nom de fichier X. On veut en B2 un lien hypertexte vers ce fichiersi celui ci existe.

=SI(existefichier(A2&".xls");LIEN_HYPERTEXTE("[" &A2&".xls]";A2);"")

Dans un module

Function existeFichier(fichier, Optional répertoire)
  Application.Volatile
  If IsMissing(répertoire) Then répertoire = ThisWorkbook.Path
   temp = Dir(répertoire & "\" & fichier)
   existeFichier = (temp <> "")
End Function

Liens vers des onglets

Les onglets ont un nom générique (Moisxx)

En A3: =LIEN_HYPERTEXTE("#'Mois" & LIGNES($1:1) & "'!A1";"Mois" &LIGNES($1:1))

Les onglets sont nommés Janvier,Février,...

En B3:
=LIEN_HYPERTEXTE("#"&TEXTE(DATE(;LIGNES($1:1);1);"mmmm")&"!a1";TEXTE(DATE(;LIGNES($1:1);1);"mmmm"))

Onglets hyperliens
Onglet hyper Lien2
Onglet hyper Lien3

OngletHyperLien3

Pour chaque code de la colonne B de Feuil1, on veut un lien vers le code associé dans Feuil2 dans la colonne B.

En C2:
=SI(D2="ok";LIEN_HYPERTEXTE("#feuil2!"&ADRESSE(EQUIV(B2;Feuil2!$B$1:$B$140;0);2);A2);"")

LienHyperAutreFeuille

Planning avec lien hyper-texte

En B2:
=SI(SOMMEPROD((Noms=$A2)*(B$1>=Début)*(B$1<=Fin))>0;LIEN_HYPERTEXTE("#bd!a"&MIN(SI((Noms=$A2)*
(B$1>=Début)*(B$1<=Fin);LIGNE(Taches)));INDEX(Taches;MIN(SI((Noms=$A2)*
(B$1>=Début)*(B$1<=Fin);LIGNE(Taches)))-1));"")
Valider avec aj+ctrl+entrée

ou

=SI(SOMMEPROD((Noms=$A4)*(Q$1>=Début)*(Q$1<=Fin))>0;LIEN_HYPERTEXTE("#bd!A"&
SOMMEPROD((Noms=$A4)*(Q$1>=Début)*(Q$1<=Fin)*LIGNE(Noms));INDEX(Taches;
SOMMEPROD((Noms=$A4)*(Q$1>=Début)*(Q$1<=Fin)*LIGNE(Noms))-1));"")

LienHyperBD

Sommaire dynamique avec Lien_Hypertexte()

Onglets hyperliens

Créer les noms de champ:

NbFeuilles =LIRE.CLASSEUR(4)
NomsFeuilles =STXT(LIRE.CLASSEUR(1);TROUVE("]";LIRE.CLASSEUR(1))+1;99)&INDIRECT("iv65000")

En B8:
=SI(LIGNES($1:1)<=NbFeuilles;LIEN_HYPERTEXTE("#'"&INDEX(NomsFeuilles;LIGNES($1:1)) & "'!A1";INDEX(NomsFeuilles;LIGNES($1:1)));"")

Version trié

La colonne B est cachée

Noms de champ
nf =STXT(LIRE.CLASSEUR(1);TROUVE("]";LIRE.CLASSEUR(1))+1;99)&INDIRECT("iv65000")
champ =DECALER(Accueil!$B$3;;;NB.SI(Accueil!$B$3:$B$10;"><"&""))

En B2: =SI(NBVAL(nf)>=LIGNES($1:2);INDEX(nf;LIGNES($1:2));"")

En C3:
=SI(LIGNES($1:1)<NBVAL(nf);
LIEN_HYPERTEXTE("#'"&INDEX(champ;EQUIV(LIGNES($1:1);NB.SI(champ;"<="&champ);0))&"'!a1";INDEX(champ;EQUIV(LIGNES($1:1);NB.SI(champ;"<="&champ);0)));"")
Valider avec maj+ctrl+entrée

SommaireTrié

Sommaire avec cellules A1 des onglets

=SI(NBVAL(nf)>=LIGNES($1:2);LIEN_HYPERTEXTE("#'"&INDEX(nf;LIGNES($1:2))&"'!a1";INDIRECT("'"&INDEX(nf;LIGNES($1:2))&"'!A1"));"")

SommaireA1

Liens hypertextes vers feuille suivante et feuille précédente

Créer un nom de champ
Nf =STXT(LIRE.CLASSEUR(1);TROUVE("]";LIRE.CLASSEUR(1))+1;99)&INDIRECT("iv65000")

=SI(EQUIV(STXT(CELLULE("filename";B1);TROUVE("]";CELLULE("filename";B1))+1;99);Nf;0)>1;
LIEN_HYPERTEXTE("#"&INDEX(Nf;EQUIV(STXT(CELLULE("filename";B1);TROUVE("]";CELLULE("filename";B1))+1;99);Nf;0)-1)&"!a1";"Précédent");"")

=SI(EQUIV(STXT(CELLULE("filename";B1);TROUVE("]";CELLULE("filename";B1))+1;99);Nf;0)<NBVAL(Nf);
LIEN_HYPERTEXTE("#"&INDEX(Nf;EQUIV(STXT(CELLULE("filename";B1);TROUVE("]";CELLULE("filename";B1))+1;99);Nf;0)+1)&"!a1";"Suivant");"")

Liens hypertextes suivant précédent

Création d'un lien HyperTexte en VBA

Hyperlinks.Add Anchor:=cellule, Address:=xx, SubAddress:= yy, TextToDisplay:=zz

Crée un lien hypertexte.

Création d’un sommaire

Sur cet exemple, une page d'accueil avec un sommaire des onglets du classeur est créée.

Sub sommaire_hyper_lien()
  On Error Resume Next
  Err = 0
  Sheets("Accueil").Select
  If Err <> 0 Then
     Sheets.Add before:=Sheets(1)
     ActiveSheet.Name = "Accueil"
     ActiveSheet.Tab.ColorIndex = 3
     On Error GoTo 0
     Range("c4") = "Sommaire"
     ActiveWindow.DisplayGridlines = False
     Range("c4").Font.Bold = True
     Range("c4").Font.Size = 12
     Range("c4").Select
     Range("A1") = Date
     Range("c1").Select
  End If
  '--
  Range("c6").Select
  For i = 2 To Sheets.Count
    x = Sheets(i).Name
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & x & "'" & "!A1", TextToDisplay:=x
   ActiveCell.Offset(1, 0).Select
  Next i
End Sub

Affiche un sommaire avec hyperliens avec maj automatique

La maj du sommaire est automatique si une feuille est ajoutée ,supprimée ou renommée.

Sommaire Dynamique

Private Sub Worksheet_Activate()
  [C5:C100].ClearContents
  For i = 2 To Sheets.Count
    nf = Sheets(i).Name
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 6, 3), Address:="", SubAddress:="'" & _
      nf & "'" & "!A1", TextToDisplay:=nf
   Next i
   [C5:C100].Sort Key1:=Range("C5"), Order1:=xlAscending, Header:=xlGuess
End Sub

Suivant/Précédent

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If ActiveSheet.Index > 1 Then
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, 1), Address:="", SubAddress:="'" & _
      Sheets(1).Name & "'" & "!A1", TextToDisplay:=Sheets(1).Name
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, 2), Address:="", SubAddress:="'" & _
      Sheets(ActiveSheet.Index - 1).Name & "'" & "!A1", TextToDisplay:="<"
  End If
  If ActiveSheet.Index < Sheets.Count Then
     ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, 3), Address:="", SubAddress:="'" & _
       Sheets(ActiveSheet.Index + 1).Name & "'" & "!A1", TextToDisplay:=">"
  End If
End Sub

Sommaire Dynamique Couleur

Private Sub Worksheet_Activate()
  [C5:C100].ClearContents
  For i = 2 To Sheets.Count
    nf = Sheets(i).Name
    nfcellule = Selection.Interior.ColorIndex
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 3, 3), Address:="", SubAddress:="'" & _
    nf & "'" & "!A1", TextToDisplay:=nf
    Cells(i + 3, 3).Interior.Color = Sheets(i).Tab.Color ' fond
    Cells(i + 3, 3).Font.Color = RGB(255, 255, 255) - Sheets(i).Tab.Color ' écriture
  Next i
End Sub

Crée des hyper-liens vers des onglets

Le texte affiché est le texte contenu en A1 de chaque onglet

Sub creeLiens()
  Sheets(1).Select
  For i = 2 To Sheets.Count
    texte = Sheets(i).[A1]
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(2 + i, 1), _
      Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=texte
  Next i
End Sub

Pointe vers la dernière ligne de chaque onglet

- SommaireDynamique2 -

Private Sub Worksheet_Activate()
  Range("C6").Select
  Range(ActiveCell, [C65000].End(xlUp)).ClearContents
  For i = 2 To Sheets.Count
    nf = Sheets(i).Name
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & _
    nf & "'" & "!A" & Sheets(i).[A65000].End(xlUp).Row, TextToDisplay:=nf
    ActiveCell.Offset(1, 0).Select
  Next i
End Sub

Crée un hyper-lien vers la dernière page visitée

DernièrePageVisitée

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
  Sheets("accueil").Hyperlinks.Add Anchor:=Sheets("accueil").[H9], Address:="", _
      SubAddress:="'" & Sh.Name & "'" & "!A1", TextToDisplay:="Dernière visite:" & Sh.Name
End Sub

Créer des hyper-liens vers les onglets d'un autre classeur

Sub GenereLiensOngletsAutreClasseur()
   classeurPrincipal = ActiveWorkbook.Name
   nf = Application.GetOpenFilename("Fichiers Xls,*.xls")
   If nf <> False Then
     Workbooks.Open Filename:=nf
     SecondClasseur = ActiveWorkbook.Name
     Windows(classeurPrincipal).Activate
     For i = 1 To Workbooks(SecondClasseur).Sheets.Count
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, 1), Address:=nf, SubAddress:= _
           "'" & Workbooks(SecondClasseur).Sheets(i).Name & "'!a1", TextToDisplay:="'" & _
        Workbooks(SecondClasseur).Sheets(i).Name
    Next i
    Workbooks(SecondClasseur).Close
  End If
End Sub

Génère des hyper-liens vers les procédures du classeur

ListeProc

Supprimer tous les hyperliens

Cells.Hyperlinks.Delete

Collection des hyper-liens

Liens de toute la feuille

For Each h In ActiveSheet.Hyperlinks
  MsgBox h.TextToDisplay
Next h

For i = 1 To ActiveSheet.Hyperlinks.Count
   MsgBox ActiveSheet.Hyperlinks(i).TextToDisplay
Next i

Liens d'un champ

For Each h In ActiveSheet.Range("B4:B5").Hyperlinks
   MsgBox h.TextToDisplay
Next h

For i = 1 To Sheets(1).Range("B4:B5").Hyperlinks.Count
  MsgBox ActiveSheet.Range("B4:B5").Hyperlinks(i).TextToDisplay
Next i

Récupérer l'adresse d'un lien

Function AdrLien(c As Range)
   AdrLien = Mid(c.Hyperlinks(1).Address, 1)
End Function

Récupérer le texte d'un lien

Function TexteLien(c As Range)
  TexteLien = Mid(c.Hyperlinks(1).TextToDisplay, 1)
End Function

Récupérer l'adresse email d'un lien

Function email(c As Range)
   email = Mid(c.Hyperlinks(1).Address, 8)
End Function

Dernière visite

Crée un hyper-lien sur la première page pour revenir sur la page précédente.

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
  Sheets(1).Hyperlinks.Add Anchor:=Sheets(1).[G1], Address:="", _
SubAddress:="'" & Sh.Name & "'" & "!A1", TextToDisplay:="Retour:" & Sh.Name
End Sub

Crée des liens hyperTexte vers les noms de champ

Sub essai()
   [B2].Select
   For Each n In ActiveWorkbook.Names
     nom = n.Name
     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=nom, TextToDisplay:=nom
     ActiveCell.Offset(1, 0).Select
   Next n
End Sub

Crée des hyperliens vers les fichiers d'un répertoire

Sub HyperLiens()
  Application.ScreenUpdating = False
  Range("A2:E65000").ClearContents
  ChDir ActiveWorkbook.Path
  Range("A2").Select
  nf = Dir("*.xls")
  Do While nf <> ""
     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:=nf
     ActiveCell.Offset(0, 1) = FileDateTime(nf)
     ActiveCell.Offset(0, 2) = FileLen(nf)
     ActiveCell.Offset(0, 3) = GetAttr(nf)
     If GetAttr(nf) And vbReadOnly Then ActiveCell.Offset(0, 4) = ActiveCell.Offset(0, 4) & " Lect"
     ActiveCell.Offset(1, 0).Select
      nf = Dir
   Loop
   Range("A2").Select
End Sub

Modification du texte d’un hyperlien

On prend le texte à droite:

Sub Modifie()
  Range("B2").Select
  Do While ActiveCell <> ""
     ActiveCell.Hyperlinks(1).TextToDisplay = ActiveCell.Offset(0, 1)
     ActiveCell.Offset(1, 0).Select
  Loop
End Sub

On ajoute 'yy' au texte actuel.

Sub Modifie2()
  For Each h In ActiveSheet.Hyperlinks
     h.TextToDisplay = h.Name & "yy"
  Next h
End Sub

Modification du répertoire

Des liens pointent vers des fichiers. Les fichiers sont déplacés d'un répertoire dans un autre

Sub ModifieAddresse()
  NvRepertoire = "c:\Mesdoc\ExcelMacroNouveau\1001exemples\"
  For Each h In ActiveSheet.Hyperlinks
    a = Split(Replace(h.Address, "\", "/"), "/")
    nf = a(UBound(a))
    h.Address = NvRepertoire & nf
  Next h
End Sub

Liste des liens hypertexte du classeur

Un onglet Temp est crée avec la liste des liens rouvés dans le classeur.

Sub ListeLiensClasseur()
  On Error Resume Next
  Application.DisplayAlerts = False
  Sheets("temp").Delete
  Sheets.Add after:=Sheets(Sheets.Count)
  ActiveSheet.Name = "temp"
  i = 2
  For Each s In ActiveWorkbook.Sheets
    For Each h In s.Hyperlinks
      ActiveSheet.Cells(i, 1) = h.TextToDisplay
      ActiveSheet.Cells(i, 2) = h.Address
      ActiveSheet.Cells(i, 3) = h.SubAddress
      ActiveSheet.Cells(i, 4) = h.Parent.Address
      ActiveSheet.Cells(i, 5) = s.Name
      i = i + 1
    Next h
  Next s
  Cells.EntireColumn.AutoFit
End Sub

Transformer des adresses email sous forme de texte en hyper-liens

For Each c In [A1:A5]
  ActiveSheet.Hyperlinks.Add c, "mailto:" & c
Next c

Transformer des textes sous forme de texte en hyper-liens

For Each c In [A1:A5]
  ActiveSheet.Hyperlinks.Add Anchor:=c, Address:=c.Value, TextToDisplay:=c.Value
Next c

FollowHyperlink

expression.FollowHyperlink(Addresse,SousAddress, NewWindow)

Exécute le lien hypertext.

ActiveWorkbook.FollowHyperlink Address:="http://www.google.fr", NewWindow:=True

Choix d'un mail ou d'un lien

ChoixMailLien

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$2" Then
    ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=Target.Value, TextToDisplay:=Target.Value
  End If
End Sub

Choix d'un mail avec Lien_hypertexte

=LIEN_HYPERTEXTE("mailto:"&RECHERCHEV(A2;Noms;2;FAUX);RECHERCHEV(A2;Noms;2;FAUX))

Choix d'un mail avec FollowHyperLink

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$2" Then
     temp = Application.Index([noms], , 1).Find(Target, LookAt:=xlWhole).Offset(, 1)
     ActiveWorkbook.FollowHyperlink Address:="mailto:" & temp
  End If
End Sub

Choix d'un lien avec FollowHyperLink

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$2" Then
     ActiveWorkbook.FollowHyperlink Address:=Target, NewWindow:=True
  End If
End Sub

Choix d'un lien vers une feuille

DVLien
HyperLienDéroulant

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$2" Then
    temp = [liens].Find(what:=Target).Hyperlinks(1).SubAddress
    a = Split(temp, "!")
    Application.Goto Reference:=Sheets(a(0)).Range(a(1))
  End If
End Sub

Choix d'un lien du classeur dans un comboBox

Affiche dans un combobox tous les liens du classeur.

ChoixLien

Private Sub UserForm_Initialize()
  m = 0
  For s = 1 To Sheets.Count
    For i = 1 To Sheets(s).Hyperlinks.Count
      Me.ComboBox1.AddItem
      Me.ComboBox1.List(m, 0) = Sheets(s).Hyperlinks(i).TextToDisplay
      Me.ComboBox1.List(m, 1) = Sheets(s).Hyperlinks(i).SubAddress
      m = m + 1
    Next i
  Next s
End Sub

Private Sub ComboBox1_Change()
  temp = Me.ComboBox1.Column(1)
  a = Split(temp, "!")
  Application.Goto Reference:=Sheets(a(0)).Range(a(1))
End Sub

Création d'hyperliens avec des shapes

Cree Shapes hyperliens

Sub CreeShape2()
  For i = 1 To 3
    Set s = Sheets(1).Shapes.AddShape(msoShapeOval, 50, 30 * i, 100, 25)
    With s
    .TextFrame.Characters.Text = " Feuil" & i + 1
    .TextFrame.Characters.Font.Color = vbWhite
    .Fill.ForeColor.RGB = vbRed
    .Line.ForeColor.RGB = vbWhite
   End With
   Sheets(1).Hyperlinks.Add Anchor:=s, Address:="", SubAddress:="Feuil" & i + 1 & "!A1"
  Next i
End Sub