Microsoft 365 Conserver lien hypertexte avec une fonction RechercheV

S

spike29

XLDnaute Occasionnel
Bonjour,

J'ai un fichier qui regroupe plusieurs fiches clients, une fiche client égale une feuil de calcul.
Dans la feuil "Liste", en cellule C15, j'ai une liste déroulante qui me permet via une recherche V de ressortir un descriptif de la fiche en cellule F15.
Dans la feuil de calcul "Données" se trouve en cellule I9 à I11 les données sources de cette rechercheV. Des liens hypertextes permettent directement de renvoyer l'utilisateur à la fiche concernée (fiches qui se trouvent dans le même classeur, ou parfois de renvoyer vers un autre fichier).

L'idée serait de pouvoir directement intégrer le lien hypertexte avec le résultat de la rechercheV. L'utilisateur n'aurait plus qu'a cliquer sur le résultat présent en cellule F15 de la Feuil Liste et serait directement renvoyé vers la fiche client concernée.

Afin d'illustrer mon propos un fichier reprenant ma problématique. J'ai testé deux formules mais sans succès :


- Formule 1 en cellule F15 => LIEN_HYPERTEXTE(RECHERCHEV(C15;Données!H9:I11;2;0))

- Formule 2 en cellule F16 => LIEN_HYPERTEXTE("#"&RECHERCHEV(C15;Données!H9:I11;2;0)&"!C7";RECHERCHEV(C15;Données!H9:I11;2;0))


Merci d'avance pour votre aide

Bonne journée

Cordialement,
 

Pièces jointes

  • TEST2.xlsx
    18 KB · Affichages: 7
Trier par date Trier par votes
S

spike29

XLDnaute Occasionnel
Bonsoir,

C'est parfait et le code fonctionne très bien chez moi après l'avoir adapté au fichier. Encore merci.

Je me permet une dernière question. Pour un souci de protection et de lisibilité sur le document, j'aimerai masquer l'ensemble des feuils de calcul vers lesquelles pointent les liens hypertexte. Toutefois, lorsque je fais cela, impossible au lien hypertexte de trouver la feuil cible.

Mon besoin :
Une Feuil de calcul masquée et associée au lien hypertexte doit pouvoir apparaître à l'utilisateur lorsqu'il va cliquer sur le lien situé en cellule C6 de la feuil data.

Je connais le code :

VB: 
Sheets("xxxxxx)").Visible = True

Cependant, si tenté que cela soit possible, je ne vois pas trop où et comment l'insérer pour arriver à mes fins.

Le fichier en PJ.

Bonne soirée et encore merci :)
 

Pièces jointes

  • TEST2.xlsm
    34.1 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour spike29, le forum,

Voyez le fichier joint et cette macro :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$6" Then Exit Sub
Dim w As Worksheet, c As Range, sa$, feuille$
For Each w In Worksheets
    If LCase(w.Name) Like "truc*" Then w.Visible = xlSheetHidden 'masque les feuilles
Next w
Set c = Sheets("data").Columns(5).Find(Target(1), , xlValues, xlWhole)
Target(1, 2) = "" 'RAZ
If c Is Nothing Or Target = "" Then Exit Sub
Target(1, 2) = c(1, 2).Value
If c(1, 2).Hyperlinks.Count Then
    sa = c(1, 2).Hyperlinks(1).SubAddress
    Hyperlinks.Add Target(1, 2), "", sa
    feuille = Left(sa, InStr(sa, "!") - 1)
    On Error Resume Next
    If IsError(Sheets(feuille)) Then MsgBox "La feuille " & feuille & " n'existe pas !", 48: Exit Sub
    Sheets(feuille).Visible = xlSheetVisible 'affiche la feuille
End If
End Sub
A+
 

Pièces jointes

  • TEST2.xlsm
    34.9 KB · Affichages: 6
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
En fait il est demandé d'afficher la feuille quand on clique sur le lien.

Donc utilisez dans le code de la feuille test :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$6" Then Exit Sub
Dim c As Range
Set c = Sheets("data").Columns(5).Find(Target(1), , xlValues, xlWhole)
Target(1, 2) = "" 'RAZ
If c Is Nothing Or Target = "" Then Exit Sub
Target(1, 2) = c(1, 2)
If c(1, 2).Hyperlinks.Count Then Hyperlinks.Add Target(1, 2), "", c(1, 2).Hyperlinks(1).SubAddress
End Sub
Et dans ThisWorkbook :
VB: 
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If LCase(Sh.Name) Like "truc*" Then Sh.Visible = xlSheetHidden 'masque la feuille
End Sub

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal h As Hyperlink)
On Error Resume Next
With Evaluate(h.SubAddress)
    .Parent.Visible = xlSheetVisible 'affiche la feuille
    Application.Goto .Cells
End With
End Sub
 

Pièces jointes

  • TEST2.xlsm
    36.2 KB · Affichages: 1
Vote positif 0 Vote négatif
S

spike29

XLDnaute Occasionnel
Bonjour,

Merci pour vos différents retours, cela fonctionne parfaitement.

J’ai légèrement modifié le code de sorte à ne faire apparaître que la feuil « test » à l’ouverture.

Le code :

VB: 
Dim sh As Worksheet

For Each sh In ThisWorkbook.Worksheets

With sh

If Not .Name = "test" Then .Visible = False

End With

Next

En effet, je ne l’ai pas précisé mais les autres feuils sont susceptibles de s’appeler autrement que truc*.

Entre temps, j’ai amélioré l’ergonomie de mon fichier en y ajoutant une liste déroulante en cascade, cellules A6 et B6 du fichier test.
Cette liste permet de réduire le nombre d'items à choisir en cellule B6 en fonction du critère sélectionné en cellule A6.

J'ai également tenté d'ajouter une liste déroulante avec auto-complétion dans la colonne B6 de la feuil test mais sans succès (elle n'est pas active dans le fichier en PJ).
En effet, même avec la liste déroulante en cascade, l'idée est de permettre une souplesse de recherche pour l'utilisateur.

Le détail du besoin est repris dans le fichier en PJ.


Je suppose que pour cumuler la liste déroulante imbriquée et l'autocomplétions il faut directement passer par VBA, mais je ne vois pas comment.

Merci d’avance pour vos retours et bonne journée :)
 

Pièces jointes

  • TEST4.xlsm
    43.6 KB · Affichages: 1
Vote positif 0 Vote négatif
S

spike29

XLDnaute Occasionnel
Effectivement, ça devenait illisible.

J'ai fais du ménage côté codes, il ne reste que le nécessaire.
Côté liste de validation, la liste en cascade fonctionne (cellule A6). Selon que l'on sélectionne A,B,C ou D en cellule A6, cela modifie le choix de valeur en B6.

Le besoin serait d'ajouter en plus de cette liste déroulante en cascade, une liste avec auto-complétions en cellule B6 afin de simplifier le choix de l'utilisateur.
Sur ce fichier de test et totalement anonymisé, mon besoin peut paraître relativement futile, mais mon véritable fichier est amené à brasser un certain nombre de données et le cumul de ces deux fonctions (liste en cascade + liste avec auto-complétions) serait utile.

En PJ, le fichier dans sa version clarifiée (TEST5).

Merci encore pour votre aide et votre patience.
 

Pièces jointes

  • TEST5.xlsm
    41.7 KB · Affichages: 4
Vote positif 0 Vote négatif
S

spike29

XLDnaute Occasionnel
Ah mince, effectivement elles ne passent que depuis la version 365 il me semble. Peuvent elles se transposer sous VBA ? En prenant en compte que le tableau de données situé feuil "data" est amené à se poursuivre au delà de la ligne 23.

Merci d'avance,

Bonne fin de journée
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour spike29, le forum,

Voyez le fichier joint et le code de la feuille "test" :
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Sheets("data")
    If Target.Address = "$A$6" Then
        .Columns("R").Clear
        .[D3].CurrentRegion.Columns(1).Offset(1).Copy .[R1]
        .[R1].CurrentRegion.RemoveDuplicates 1, xlNo
        .[R1].CurrentRegion.Name = "Liste1"
        Target.Validation.Delete
        Target.Validation.Add xlValidateList, Formula1:="=Liste1" 'plage nommée
    ElseIf Target.Address = "$B$6" Then
        Target.Validation.Delete
        Target = ""
        .Columns("T").Clear
        If Application.CountIf(.[D3].CurrentRegion.Columns(1).Offset(1), Target(1, 0)) = 0 Then _
            Target(1, 0).Select: CreateObject("WScript.Shell").SendKeys "%{DOWN}": Exit Sub 'déroule la liste
        .[D3].CurrentRegion.AutoFilter 1, Target(1, 0) 'filtre automatique
        .[D3].CurrentRegion.Columns(2).Offset(1).Copy .[T1]
        .[D3].CurrentRegion.AutoFilter 'ôte le filtre
        .[T1].CurrentRegion.Name = "Liste2" 'plage nommée
        Target.Validation.Add xlValidateList, Formula1:="=Liste2"
    End If
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$6" Then If Target = "" Then [B6:C6] = ""
If Target.Address <> "$B$6" Then Exit Sub
Dim c As Range
Set c = Sheets("data").Columns(5).Find(Target, , xlValues, xlWhole)
Target(1, 2) = "" 'RAZ
If c Is Nothing Or Target = "" Then Exit Sub
Target(1, 2) = c(1, 2)
If c(1, 2).Hyperlinks.Count Then Hyperlinks.Add Target(1, 2), "", c(1, 2).Hyperlinks(1).SubAddress
End Sub
Et dans ThisWorkbook :
VB: 
Private Sub Workbook_Open()
Dim s As Object
For Each s In Sheets
    If LCase(s.Name) <> "test" Then s.Visible = xlSheetHidden
Next
Application.Goto [A1], True 'cadrage
Me.Saved = True 'évite l'invite à la fermeture si aucune modification
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Not LCase(Sh.Name) = "test" Then Sh.Visible = xlSheetHidden
End Sub

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal h As Hyperlink)
On Error Resume Next
With Evaluate(h.SubAddress)
    .Parent.Visible = xlSheetVisible 'affiche la feuille
    Application.Goto .Cells
End With
End Sub
A+
 

Pièces jointes

  • TEST5.xlsm
    43.4 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
S

spike29

XLDnaute Occasionnel
Bonjour job75,

Le code fonctionne parfaitement, à l'exception de la liste auto complétive en cellule B6 de la feuil test.
Lorsque je fais une saisie manuelle en cellule B6 j'ai le message suivant : " cette valeur ne correspond pas aux restrictions de validation des données pour cette cellule".

Je suppose qu'il faut insérer quelque part dans le code un :
VB: 
.ShowError = False

Afin de permettre une saisie manuelle dans la cellule B6, mais après de multiples tentatives, je ne vois pas où.


L'objectif final est le suivant :

Exemple : une fois que j'ai choisi le type en colonne A6 (Type A par exemple), si je fais une saisie manuelle en cellule B6 en tapant 17 pour faire ressortir uniquement les n° de SAP de type A contenant la valeur 17 dans leur numérotation, ces derniers et uniquement ces derniers apparaissent alors dans la liste déroulante. Il ne reste plus qu'à choisir celui qui convient à l'utilisateur.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour spike29, le forum,

En B6 vous voulez faire une recherche dite "intuitive" ou "intelligente".

Pas certain que ça en vaille la chandelle mais voyez ce code dans la feuille "test" :
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tablo, resu(), cible, i&, n&
With Sheets("data")
    If Target.Address = "$A$6" Then
        .Columns("P").Clear
        .[D3].CurrentRegion.Columns(1).Offset(1).Copy .[P1]
        .[P1].CurrentRegion.RemoveDuplicates 1, xlNo
        .[P1].CurrentRegion.Name = "Liste1"
        Target.Validation.Delete
        Target.Validation.Add xlValidateList, Formula1:="=Liste1" 'plage nommée
    ElseIf Target.Address = "$B$6" Then
        Target.Validation.Delete
        .Columns("R:T").Clear
        If Application.CountIf(.[D3].CurrentRegion.Columns(1).Offset(1), Target(1, 0)) = 0 Then _
            Target(1, 0).Select: CreateObject("WScript.Shell").SendKeys "%{DOWN}": Exit Sub 'déroule la liste
        .[D3].CurrentRegion.AutoFilter 1, Target(1, 0) 'filtre automatique
        .[D3].CurrentRegion.Columns(2).Offset(1).Copy .[R1]
        .AutoFilterMode = False 'ôte le filtre
        tablo = .[R1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
        ReDim resu(1 To UBound(tablo), 1 To 1)
        cible = Target
        For i = 1 To UBound(tablo)
            If InStr(tablo(i, 1), cible) Then n = n + 1: resu(n, 1) = tablo(i, 1)
        Next i
        If n Then
            .[T1].Resize(n) = resu
            .[T1].Resize(n).Name = "Liste2" 'plage nommée
            Target.Validation.Add xlValidateList, Formula1:="=Liste2"
            Target.Validation.ShowError = False
            If Target <> "" Then CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'déroule la liste
        Else
            MsgBox "Pas de correspondance..."
        End If
    End If
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$6" Then If Target = "" Then [B6:C6] = ""
If Target.Address <> "$B$6" Then Exit Sub
Target(1, 2).Select: Target.Select 'lance la macro Worksheet_SelectionChange
Dim c As Range
Set c = Sheets("data").Columns(5).Find(Target, , xlValues, xlWhole)
Target(1, 2) = "" 'RAZ
If c Is Nothing Or Target = "" Then Exit Sub
Target(1, 2) = c(1, 2)
If c(1, 2).Hyperlinks.Count Then Hyperlinks.Add Target(1, 2), "", c(1, 2).Hyperlinks(1).SubAddress
End Sub
A+
 

Pièces jointes

  • TEST5.xlsm
    44 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
Microsoft 365 recherche X lien entre 2 fichiers
Réponses
3
Affichages
178
lilie17
L
D
  • Question
Microsoft 365 [RESOLU] Problème avec la fonction RECHERCHEV
Réponses
3
Affichages
193
dilack
D
J
  • Résolu(e)
Autres Partage fichier avec lien hypertexte
2
Réponses
20
Affichages
743
TooFatBoy
TooFatBoy
S
  • Question
XL 2019 Formule RECHERCHEV avec des valeurs cherchées négatives qui ne fonctionne pas et renvoi #Réf
Réponses
2
Affichages
180
Phil69970
Phil69970
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
471
Phil69970
Phil69970
J
  • Résolu(e)
XL 2021 Coloriser et décoloriser une cellule activée par lien hypertexte
3 4 5
Réponses
71
Affichages
2 K
JMC
J
J
  • Question
Microsoft 365 Problème lien hypertexte
Réponses
5
Affichages
494
Phil69970
Phil69970
Sellig
  • Résolu(e)
XL 2019 Créer un lien Hypertexte ancré à un mot sur une autre feuille
Réponses
8
Affichages
322
sylvanu
sylvanu
L
  • Question
Microsoft 365 Comparaison des cellules de deux tableaux avec les fonctions recherchev et/ou ESTNA
Réponses
9
Affichages
428
chris
chris
Z
  • Question
XL 2016 RECHERCHEV et double liste de choix
Réponses
2
Affichages
736
zendb
Z

Membres actuellement en ligne

32 membres et 336 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
315 047
Messages
2 115 722
Membres
112 563
dernier inscrit
HarioH