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+