Microsoft 365 Conserver lien hypertexte avec une fonction RechercheV

[spike29]

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,

 

[spike29]

Bonjour,

Merci pour le code, cela fonctionne parfaitement chez moi.
Seule problématique après des multiples essais, il semblerai que la fonction Hyperlinks n'arrive pas a retranscrire les liens hypertextes pointant vers des fichiers externes lorsque j'utilise l'adresse url comme lien de fichier. En l'occurrence il s'agit d'un lien sur un sharepoint.
Exemple de lien anonymisé ci-dessous, il pointe vers un fichier power point :

https://sncf.sharepoint.com/sites/TOTO/Documents%20partages/TATA/02%20-%20Atelier%TUTU/TITI%20TETE%20%232.pptx?web=1

Lorsque le code fais appel à ce lien, j'ai le message suivant concernant la ligne de code ci-dessous : " Argument ou appel de procédure incorrect "

Hyperlinks.Add Target(1, 3), "", c(1, 3).Hyperlinks(1).SubAddress

Une bonne moitié des liens que j'utilise pointe sur des feuil de calculs dans ce classeur en revanche l'autre moitié pointe vers des fichiers type .ppt, .doc avec des liens url similaires à celui en exemple ci-dessus.

 

[job75]

Bonjour spike29,

Seule problématique après des multiples essais, il semblerai que la fonction Hyperlinks n'arrive pas a retranscrire les liens hypertextes pointant vers des fichiers externes lorsque j'utilise l'adresse url comme lien de fichier. En l'occurrence il s'agit d'un lien sur un sharepoint.

Essayez avec ce code où j'ai modifié la 3ème ligne de Worksheet_SelectionChange et les 7 dernières lignes de Worksheet_Change :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tablo, resu(), cible, i&, n&
With ThisWorkbook.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 = 0 Then Exit Sub
If c(1, 2).Hyperlinks(1).Address = "" Then
    Hyperlinks.Add Target(1, 2), "", c(1, 2).Hyperlinks(1).SubAddress
Else
    Hyperlinks.Add Target(1, 2), c(1, 2).Hyperlinks(1).Address
End If
End Sub

Je n'ai pas testé des liens vers SharePoint mais des liens vers un disque dur fonctionnent.

A+

 

[job75]

Bonjour spike29, le forum,

Dans le fichier joint le 1er lien (N° SAP 10254595) pointe vers Excel Downloads.

A+

 

[spike29]

Bonsoir job75 et le forum,

Encore merci pour cette précieuse aide, tout fonctionne parfaitement. Je confirme également que pour un accès de type sharepoint cela marche sans problème.
Depuis, mon fichier a un peu évolué dans sa présentation. La colonne "lieu" est devenue "descriptif" et j'ai ajouté une colonne dédié purement au lien.

Maitrisant assez moyennement le code, j'ai réussi à l'adapter tant bien que mal avec du "bricolage" car il faut appeler un chat un chat.
C'est moche, même très moche, mais ça fonctionne et me permet de faire disparaître le lien dans la colonne E lorsqu'il n'y a pas de valeur dans la colonne C.

En tout cas, encore merci pour votre aide et patience.

Bonne fin de journée

 

[job75]

Bonsoir spike29,

Vous avez juste ajouté une colonne dans la feuille "data", ça fonctionne bien.

A+