Lien hypertexe dans cellule

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion jeromeN95
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
jeromeN95

jeromeN95

XLDnaute Impliqué
Bonjour,
je souhaite mettre dans une cellule un lien vers une autre feuille si elle n'est pas vide, et bien sur lorsque je clique dessus, le lien me renvoie sur la page.

onglet source : "Page de garde" cellule E14
Si <>"" then lien hypertexte vers feuille "Votre Buanderie" cellule B2.
Merci
 
Trier par date Trier par votes
Re : Lien hypertexe dans cellule

Bonjour le fil 🙂,
Pour le fun, la macro d'Hippolite avec ajout d'un tableau pour ne pas copier 4 fois le code 😛...
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Byte, J As Byte, Tab1, Tab2
J = 255
Tab1 = Array(14, 16, 18, 20)
Tab2 = Array("Votre Buanderie", "Votre Cuisine", "Hébergement", "Adoucisseur")
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Application.EnableEvents = False
        For I = 0 To UBound(Tab1)
            If Tab1(I) = Target.Row Then J = I
        Next I
        If J = 255 Then Exit Sub
        If Target(1) = "" Then
            If Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = False
        Else
            If Not Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = True
            With Sheets("Page de garde")
                Lien = "'[" & ThisWorkbook.Name & "]" & Tab2(J) & "'!B2"
                temp = Target(1)
                .Hyperlinks.Add Anchor:=.Range("E" & Target.Row), Address:="", _
                    SubAddress:=Lien, TextToDisplay:=temp
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub
Bon dimanche 😎
 
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

Bonjour,
ca marche plus :
Code: 
Private Sub cmdMail_click()
Mail_with_outlook 'transfert le dossier complet à une personne NES
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'masquer et afficher les commandes !
cmdMail.Visible = Not (Application.CountA(Range("F4,F6,J6,E8,E10,E12")) < 6)
If [F4] = "" Then [F4].Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Byte, J As Byte, Tab1, Tab2
J = 255
Tab1 = Array(14, 16, 18, 20)
Tab2 = Array("Votre Buanderie", "Votre Cuisine", "Hébergement", "Adoucisseur")
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Application.EnableEvents = False
        For I = 0 To UBound(Tab1)
            If Tab1(I) = Target.Row Then J = I
        Next I
        If J = 255 Then Exit Sub
        If Target(1) = "" Then
            If Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = False
        Else
            If Not Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = True
            With Sheets("Page de garde")
                Lien = "'[" & ThisWorkbook.Name & "]" & Tab2(J) & "'!B2"
                temp = Target(1)
                .Hyperlinks.Add Anchor:=.Range("E" & Target.Row), Address:="", _
                    SubAddress:=Lien, TextToDisplay:=temp
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub


Je ne comprend pas.
Hier ca fonctionner et aujourd'hui plus rien.

Plus de lien.

Merci de m'aider SVPPP...
 
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

Re 🙂,
Ça commence bien, appel d'une Sub inconnue : "Ajust_Commentaires" 🙄...
Par contre, je pense avoir trouvé ton problème 😛...
Dans le code, pour éviter de déclencher des "effets de bord", il y a
Code: 
Application.EnableEvents = False
Si le code plante avant de rencontrer
Code: 
Application.EnableEvents = True
les événementielles sont déconnectées 🙄...
Pour les relancer, une petite Sub Test
Code: 
Sub Test()
Application.EnableEvents = True
En Sub
permetra de remettre les événementielles en route 😉 !
Teste et dis nous 😛.
Bonne soirée 😎
 
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

Bonsoir, effectivement, ca marche mieux comme ça :
Code: 
Private Sub cmdMail_click()
Mail_with_outlook 'transfert le dossier complet à une personne NES
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'masquer et afficher les commandes !
cmdMail.Visible = Not (Application.CountA(Range("F4,F6,J6,E8,E10,E12")) < 6)
If [F4] = "" Then [F4].Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Byte, J As Byte, Tab1, Tab2
J = 255
Tab1 = Array(14, 16, 18, 20)
Tab2 = Array("Votre Buanderie", "Votre Cuisine", "Hebergement", "Adoucisseur")
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Application.EnableEvents = True 'a remettre en false
        For I = 0 To UBound(Tab1)
            If Tab1(I) = Target.Row Then J = I
        Next I
        If J = 255 Then Exit Sub
        If Target(1) = "" Then
            If Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = False
        Else
            If Not Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = True
            With Sheets("Page de garde")
                Lien = "'[" & ThisWorkbook.Name & "]" & Tab2(J) & "'!B2"
                temp = Target(1)
                .Hyperlinks.Add Anchor:=.Range("E" & Target.Row), Address:="", _
                    SubAddress:=Lien, TextToDisplay:=temp
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub

Mais c'est pas grave si je le laisse comme ça?
Je veux dire si ca plante...
 
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

Bonjour le forum,
j'ai ce code qui marche bien :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte, J As Byte, Tab1, Tab2
J = 255
Tab1 = Array(14, 16, 18, 20)
Tab2 = Array("Votre Buanderie", "Votre Cuisine", "Hebergement", "Adoucisseur")
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Application.EnableEvents = True 'a remettre en false
        For i = 0 To UBound(Tab1)
            If Tab1(i) = Target.Row Then J = i
        Next i
        If J = 255 Then Exit Sub
        If Target(1) = "" Then
            If Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = False
        Else
            If Not Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = False
            With Sheets("Page de garde")
                Lien = "'[" & ThisWorkbook.Name & "]" & Tab2(J) & "'!B2"
                temp = Target(1)
                .Hyperlinks.Add Anchor:=.Range("E" & Target.Row), Address:="", _
                    SubAddress:=Lien, TextToDisplay:=temp
            End With
        End If
        Application.EnableEvents = True
    End If


End Sub

J'aimerai néanmoins que l'on puisse rentrer le nom dans la cellule, afficher le lien hypertext (ça ok) mais pas afficher la page tout de suite.
Il faut que la page s'affiche que lorsque l'on clique sur le lien.

SVP, merci.
 
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

Re 🙂,
Là, ça devient vraiment de la bidouille 🙄 ...
Mets la ligne du milieu en commentaire
Code: 
        Else
'            If Not Sheets(Tab2(J)).Visible Then Sheets(Tab2(J)).Visible = False
            With Sheets("Page de garde")
et ajoute dans ThisWorkbook
Code: 
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim NomFeuille As String
NomFeuille = Split(Split(Target.SubAddress, "'")(1), "]")(1)
Sheets(NomFeuille).Visible = True
Sheets(NomFeuille).Select
Range("B2").Select
End Sub
Bon courage 😎
 
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

Bonjour, pourquoi de la bidouille?
Le resultat est nikel, ca fonctionne, c'est le principal!
Vous êtes doué!

Merci beaucoup.

Pardon mais j'ai un petit soucci :
Code: 
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim NomFeuille As String
[U][B][I]NomFeuille = Split(Split(Target.SubAddress, "'")(1), "]")(1)[/I][/B][/U]
Sheets(NomFeuille).Visible = True
Sheets(NomFeuille).Select
Range("B2").Select
End Sub

J'ai une erreur "L'indice n'appartient pas à la séléction" lorsque j'execute un lien hypertext d'une autre cellule (complétement a part).
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

jeromeN95 à dit:
Bonjour, pourquoi de la bidouille?
Le resultat est nikel, ca fonctionne, c'est le principal!
...
Pardon mais j'ai un petit soucci :
...
J'ai une erreur "L'indice n'appartient pas à la séléction" lorsque j'execute un lien hypertext d'une autre cellule (complétement a part).
Cliquez pour agrandir...
C'est bien parce que c'est de la bidouille 🙄...
J'intercepte les liens Hypertext, donc il va falloir tester les autres liens pour les laisser s'exécuter normalement 😛...
Tes liens sont où, et vont vers où 🙄 ?...
A + 😎
 
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

Dans un onglet qui s'appelle "Buanderie" en I16:I25 qui font un lien vers un dossier partagé via :
Code: 
Sub FicheTechnique(stValue As String)
Dim stFichier, stExtention As String
Dim lngShell As Long
On Error Resume Next
    stFichier = Dir(conChemin & stValue & ".*")
    stExtension = Right(stFichier, 3)
    If stFichier = "" Then
        MsgBox " La FT n'existe pas.", vbCritical, "Information"
    Else
        lngShell = ShellExecute(0, "Open", conChemin & stFichier, "", "", 0)
    End If
End Sub
Function RechercheFicheEGP(stChemin As String, stCol As String, intRow As Integer, stCell As String, stDossier As String) As String
Dim stValue, stFichier, stExtention As String
On Error Resume Next
    stValue = Range(stCol & intRow).Value
    stFichier = Dir(stChemin & stValue & ".*")
    stExtension = Right(stFichier, 3)
    If stFichier = "" Then
        Range(stCell & intRow).Hyperlinks.Delete
        RechercheFicheEGP = Range(stCell & intRow)
    Else
        ActiveSheet.Hyperlinks.Add Anchor:=Range(stCell & intRow), Address:=stChemin & stValue & "." & stExtension
        RechercheFicheEGP = Range(stCell & intRow)
    End If
End Function

ainsi que ceci dans un modul car j'importe avec une validation dans un USF :
Code: 
rivate Sub CmbValider_Click()
On Error Resume Next

Dim stNom As String
'Effacer les anciennes références
Sheets("Buanderie").Range("Préconisation").ClearContents

For Each c In Me.Controls
    If UCase(Left(c.Name, 2)) = "CB" Or UCase(Left(c.Name, 2)) = "LT" Then
        stNom = Right(c.Name, Len(c.Name) - 2)
        With Sheets("Buanderie")
                        'création lien Hypertexte
            .Cells(Range(stNom).Row, Range(stNom).Column + 2).FormulaR1C1 = RechercheFicheEGP(conChemin, "I", Range(stNom).Row, "I", "Doc/")
        End With
    End If
Next
 
Vote positif 0 Vote négatif
Re : Lien hypertexe dans cellule

Re 🙂
jeromeN95 à dit:
Dans un onglet qui s'appelle "Buanderie" en I16:I25 qui font un lien vers un dossier partagé via :
...
ainsi que ceci dans un modul car j'importe avec une validation dans un USF :
Cliquez pour agrandir...
Donc tu veux traiter l'onglet "Votre Buanderie" et pas l'onglet "Buanderie", il suffit d'ajouter en début de ma Sub après avoir rempli la variable NomFeuille
Code: 
If NomFeuille = "Buanderie" Then Exit Sub
Pour l'USF, tu peux déclarer une variable booléenne publique en haut d'un module standard
Code: 
Public Flag As Boolean
Dans l'initialize de ton USF
Code: 
Flag = True
Avant de quitter ton USF
Code: 
Flag = False
et en début de mon code
Code: 
If Flag = True Then Exit Sub
Mais tu vois que la bidouille entraine la bidouille 🙄...
Bon courage 😎
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Question Question
XL 2021 Lien mail hypertexte fonctionnel
Réponses
4
Affichages
226
sfconstant
S
N
  • Résolu(e)
XL 2013 Vérifier ci cellule pleine : réponse cellule adjacente
Réponses
3
Affichages
323
Nico77
N
S
  • Résolu(e)
XL 2021 "Blocage de la mise a jour d'une cellule"
Réponses
8
Affichages
314
Steph733
S
Dudu2
  • Résolu(e)
XL 2021 VBA - Recevoir un signal d'une autre Application
2 3
Réponses
44
Affichages
893
Dudu2
Dudu2
J
  • Question Question
XL 2021 Probleme avec la fonction LIENHYPERTEXT
Réponses
6
Affichages
270
vgendron
vgendron
J
  • Résolu(e)
XL 2021 Coloriser et décoloriser une cellule activée par lien hypertexte
3 4 5
Réponses
71
Affichages
3 K
JMC
J
J
  • Résolu(e)
Autres Partage fichier avec lien hypertexte
2
Réponses
20
Affichages
1 K
TooFatBoy
TooFatBoy
D
  • Résolu(e)
XL 2019 Boucle sur plusieurs feuilles
Réponses
6
Affichages
505
dadaze
D
Sellig
  • Résolu(e)
XL 2019 Créer un lien Hypertexte ancré à un mot sur une autre feuille
Réponses
8
Affichages
555
sylvanu
sylvanu
L
  • Question Question
Microsoft 365 recherche X lien entre 2 fichiers
Réponses
3
Affichages
330
lilie17
L
D
  • Résolu(e)
Microsoft 365 vba récupérer valeur cellule d'une autre feuille
Réponses
3
Affichages
244
Diane272727
D
E
  • Résolu(e)
Microsoft 365 Report d'une cellule
2
Réponses
17
Affichages
321
sylvanu
sylvanu
S
  • Résolu(e)
Microsoft 365 Conserver lien hypertexte avec une fonction RechercheV
2
Réponses
19
Affichages
1 K
job75
job75
M
  • Résolu(e)
XL 2021 Récupérer la valeur d’une cellule dans un classeur fermé
Réponses
5
Affichages
231
patricktoulon
patricktoulon
D
  • Résolu(e)
XL 2021 Créer feuilles automatiquement dans un classeur a partir d'une liste et lien hypertexte
Réponses
6
Affichages
688
Phil69970
Phil69970
D
  • Résolu(e)
Microsoft 365 VBA Déplacement de la cellule active dans une ligne sélectionnée
Réponses
11
Affichages
314
danielco
D
C
  • Résolu(e)
XL 2013 Renvoyer 2 dans la cellule
Réponses
2
Affichages
310
candido57
C
R
  • Question Question
Microsoft 365 aide recherche multiple entrées d'une cellule dans colonne
2
Réponses
16
Affichages
1 K
richard31
R
vgendron
  • Résolu(e)
Power Query importer fichier CSV, dont le chemin est dans une cellule Excel
Réponses
11
Affichages
275
oguruma
oguruma
E
  • Résolu(e)
Microsoft 365 Reduire Temps Execution Code
Réponses
5
Affichages
380
eric72
E
Retour