Lien hypertexe dans cellule

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
jeromeN95

jeromeN95

XLDnaute Impliqué
Re : Lien hypertexe dans cellule

Salut,
euh, soit je comprend pas où mettre les codes, soit c'est les codes :
Dans ThisWorkBook j'ai :
Code: 
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim NomFeuille As String
   ' If Target.Address = "E12:E20" Then
   If NomFeuille = "Buanderie" Then Exit Sub 'ajout bidouille
If Flag = True Then Exit Sub 'ajout bidouille

NomFeuille = Split(Split(Target.SubAddress, "'")(1), "]")(1)
Sheets(NomFeuille).Visible = True
Sheets(NomFeuille).Select
Range("B2").Select
   ' End If
End Sub
"Dans page de garde" :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Flag = True Then Exit Sub 'ajout bidouille
    If NomFeuille = "Buanderie" Then Exit Sub 'ajout bidouille
    
    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

et rajouter dans un modul 1 :
Code: 
Public Flag As Boolean

Helpe me ...
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Lien hypertexe dans cellule

Re :),
jeromeN95 à dit:
Salut,
euh, soit je comprend pas où mettre les codes, soit c'est les codes :
...
Helpe me ...
Cliquez pour agrandir...
Sans être méchant, tu es peut-être optimiste dans ta signature avec 7% :p...
Plus sérieusement, tu empiles les codes sans les comprendre, donc forcément, ça peux pas le faire :rolleyes:...
Code: 
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim NomFeuille As String
If Flag = True Then Exit Sub 'ajout bidouille
NomFeuille = Split(Split(Target.SubAddress, "'")(1), "]")(1)
If NomFeuille = "Buanderie" Then Exit Sub 'ajout bidouille
Sheets(NomFeuille).Visible = True
Sheets(NomFeuille).Select
Range("B2").Select
End Sub
Comment veux-tu comparer NomFeuille tant que NomFeuille n'a pas été renseigné :mad:...
Le code de feuille n'a aucune raison d'être modifié, il écrit des liens, il ne les suit pas :rolleyes:...
Et je ne vois pas les codes de ton USF :(...
Bon courage :cool:
 
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
Re : Lien hypertexe dans cellule

Ok, c'est pour cela que j'ai rajouter :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Byte, J As Byte, Tab1, Tab2
[B]Dim Lien As String[/B]

   If Sheet.Name = "Buanderie" Then Exit Sub 'ajout bidouille
If Flag = True Then Exit Sub 'ajout bidouille
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

Peut etre m'aideriez vous plus rapidement.
Je suis sur que ça ne doit pas être grand chose mais bon.

On va dire que 7% c'est mon objectif (pour l'un et pour l'autre).
Je suis dessus depuis 8h ! (sans compter cette nuit...).

Petit rappel :
On rentre le nom dans la cellule (ex. E14 dans la page de garde ou E16 ou E18 ou E20), on affiche 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.

Il y a des liens hypertext dans USF Buanderie (sur les combobox produi) et également dans l'onglet Exp+ (qui sont un copier coller de ceux qu'il y a dans Buanderie une fois que l'on a valider l'USF Buanderie (on clique sur ETUDE)).


Un grand merci a vous.
 
Dernière édition:
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Lien hypertexe dans cellule

Re :),
Quand je parlais des 7%, c'était par rapport à Excel, me contentant personnellement de 10 à 15% :eek:...
Dans tous tes USF (ça ne mange pas de pain)
Code: 
Private Sub UserForm_Initialize()
Flag = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Flag = False
End Sub
Pour ThisWorkbook, tu peux virer
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Byte, J As Byte, Tab1, Tab2
J = 255
Dim Lien As String
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
vu que la procédure est une procédure de feuille et non de classeur, dans un classeur, c'est
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
et dans le code feuille, ne rajoute pas les Exit, comme dit précédemment...
Bon courage :cool:
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Lien hypertexe dans cellule

Re :),
jeromeN95 à dit:
Bonsoir, alors j'ai une erreur d'execution mais résolu et une erreue : l'indice n'appartient pas a la sélection...sur :
Code: 
Lien = "'[" & ThisWorkbook.Name & "]" & Tab2(J) & "'!B2"
Cliquez pour agrandir...
Excuse-moi mais je craque :eek:...
Tu as des dizaines et des dizaines de codes dans ton fichier :mad:...
Comment veux-tu qu'on puisse faire le tri :rolleyes:...
Une programmation VBA, c'est quelque chose de réfléchi, et là, ça part dans tous les sens :confused:...
Le mieux que tu puisses faire, c'est de recommencer ton fichier sur une base neuve, en profitant de tout ce que tu as apris :rolleyes:...
Sinon, de toute façon, tôt ou tard, tu seras coincé ailleurs...
Bon courage :cool:
 
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
Re : Lien hypertexe dans cellule

Bonsoir et merci, je viens de recrée a partir d'un fichier propre.
Le code a fonctionner, les liens m'ont rapporter vers les differents onglets....
Mais 1 seul fois!
J'ai enregistrer puis fermé mais ca ne fonctionne plus.
J'ai en page de garde :
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Byte, J As Byte, Tab1, Tab2
J = 255
Dim Lien As String
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
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim NomFeuille As String
If Flag = True Then Exit Sub 'ajout bidouille
NomFeuille = Split(Split(Target.SubAddress, "'")(1), "]")(1)
If NomFeuille = "Buanderie" Then Exit Sub 'ajout bidouille
Sheets(NomFeuille).Visible = True
Sheets(NomFeuille).Select
Range("B2").Select
End Sub

et dans chaque USF :
Code: 
Private Sub UserForm_Initialize()
Flag = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Flag = False
End Sub

Rien d'autre.
une idée SVP?
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Lien hypertexe dans cellule

Re :),
Tu le fait exprès :confused::mad: ???
Dans ThisWorkbook, qui représente le classeur, la procédure est :
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
avec Sh qui représente la feuille et Target la cellule (dit et redit dans mes messages :rolleyes:...).
Dans une feuille, c'est
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
avec Target qui représente uniquement la cellule, vu que l'on est déjà dans la code de feuille, et que forcément, on connait la feuille (et reredit dans mes post précédents :eek:...) :rolleyes: :mad: !
Ces codes ne sont pas interchangeables, et évidemment, totalement inactifs vu qu'ils n'ont aucune raison d'être déclenchés :eek: :mad:...
DONC ÉVIDEMMENT ÇA NE MARCHE PAS !!!!!!!!!!!!!!!!
Que dire de plus, oh mon dieu :confused:...
 
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
Re : Lien hypertexe dans cellule

Je suis desoler d'etre aussi lourd.

J'ai modifier comme ceci alors:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Byte, J As Byte, Tab1, Tab2
J = 255
Dim Lien As String
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
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim NomFeuille As String
If Flag = True Then Exit Sub 'ajout bidouille
NomFeuille = Split(Split(Target.SubAddress, "'")(1), "]")(1)
If NomFeuille = "Buanderie" Then Exit Sub 'ajout bidouille
Sheets(NomFeuille).Visible = True
Sheets(NomFeuille).Select
Range("B2").Select
End Sub

Désoler de cette grosse erreur.
Mais alors pourquoi ca ne fonctionne pas quand meme?
 
Dernière édition:
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Lien hypertexe dans cellule

Re :),
Le premier est-il bien dans le code de la page de garde ?
Le deuxième est-il bien dans ThisWorkbook ?
Pour info, je ne peux pas tester ton fichier (que je n'ai d'ailleurs pas gardé, et dont tu as ôté le lien...) sur mon PC car 2010 64 bits ne supporte pas les appels à DLL 32 que tu utilises :rolleyes:...
J'ai vraiment l'impression que tu as récupéré des bouts de codes un peu partout (malheureusement sans les comprendre totalement), car j'ai du mal à croire que d'un côté tu ai tellement de mal entre code feuille, code classeur, etc. et que de l'autre, tu utilises des modules de classe ou des appels à DLL :p...
Bon WE :cool:
 
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
Re : Lien hypertexe dans cellule

Bonjour, non dans RhisWorkbook je n'ai rien.
Que faut'il ?

Effectivement je ne suis pas l'auteur de tout les codes.
Néanmoins je travail dessus depuis 1an.
C'est assez complexe c'est vrai mais le résultat et là. (je doit le rendre pour le 24.6)

Merci quand meme.
Bonne journée.
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Lien hypertexe dans cellule

Re :),
jeromeN95 à dit:
Bonjour, non dans RhisWorkbook je n'ai rien.
Que faut'il ?
Cliquez pour agrandir...
La procédure
Code: 
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
doit être dedans :eek:...
Littéralement : procédure classeur lien suivi dans une feuille : arguments fournis : Sh la feuille et Target l'hyperlien :rolleyes:...
De même qu'expliqué hier :
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
classeur feuille change : Sh feuille et Target cellule
par rapport à
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
feuille change : Target cellule...
Pour éviter de se tromper, quand tu est dans le code de la feuille ou du classeur, tu as un menu déroulant au dessus à gauche qui indique (Général) tant qu'il n'y a pas de procédure où tu choisis Worksheet en feuille ou Workbook en classeur, ensuite, le menu déroulant de droite (Déclarations) te propose toutes les possibilités et te permet aussi de naviguer une fois que tu as beaucoup de procédures dans le même module :p...
Cela créé automatiquement la bonne entête avec les bons arguments :rolleyes:...
Bon courage :cool:
 
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
Re : Lien hypertexe dans cellule

Bonjour, d'accord, j'ai mis dans ThisWorkBook :
Code: 
Private Sub Worksheet_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim I As Byte, J As Byte, Tab1, Tab2
J = 255
Dim Lien As String
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


Et dans "Page de Garde"
Code: 
Private Sub Worksheet_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim NomFeuille As String
If Flag = True Then Exit Sub 'ajout bidouille
Sh = Split(Split(Target.SubAddress, "'")(1), "]")(1)
If Sh = "Buanderie" Then Exit Sub 'ajout bidouille
Sheets(Sh).Visible = True
Sheets(Sh).Select
Range("B2").Select
End Sub
et aussi ceci dans chaque USF
Code: 
Private Sub UserForm_Initialize()
Flag = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Flag = False
End Sub

Mais ça ne fonctionne toujours pas.
Je n'ai aucune erreur d'indiquer mais pas de création de lien.
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
XL 2021 Lien hypertexte dans forme rectangle
Réponses
2
Affichages
163
Phil69970
Phil69970
Y
  • Question
XL 2021 Lien Hypertexte et feuilles masquées
Réponses
4
Affichages
386
Yacine
Y
Telegraphist
  • Question
XL 2016 Bouton vers lien hypertexte issus de formules
Réponses
2
Affichages
574
crocrocro
C
K
  • Question
Microsoft 365 Cohabitation difficile entre lien hypertexte et objet ActiveX
Réponses
1
Affichages
283
sousou
sousou
C
  • Question
XL 2019 Fermer une feuille par un lien hypertexte
Réponses
4
Affichages
759
Corentin2170
C
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
625
sousou
sousou
D
  • Résolu(e)
Microsoft 365 insérer un lien hypertexte par VBA
2
Réponses
22
Affichages
985
Didier03
D
C
  • Résolu(e)
Microsoft 365 Macro qui crée un lien hypertexte + se déclenche OnClick
Réponses
5
Affichages
601
AtTheOne
AtTheOne
A
  • Question
XL 2019 Ajout d'un lien hypertexte dans un mail envoyé par VBA
Réponses
2
Affichages
429
angelusr71
A
S
  • Question
Microsoft 365 Lien dans un graphique
Réponses
1
Affichages
251
sylvanu
sylvanu

Membres actuellement en ligne

9 membres et 64 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 492
Messages
2 088 942
Membres
103 989
dernier inscrit
jralonso