XL 2016 Test des liens Hypertextes

[Alex6942]

Bonjour,

Je souhaiterais tester si les liens hypertextes contenus dans des cellules sont présents dans le dossier.

Les liens sont en colonnes et , à partir de la ligne 2.

Une formule est présente dans les cellules, permettant de créer les liens hypertextes.

Je souhaiterai avoir un renvoi d'information dans les colonnes [L] pour et [M] pour , sur les lignes correspondant aux liens, avec le message "Erreur de lien" ou autre , si le lien ne redirige pas sur un fichier.

Car à partir de se message , je vais utiliser une formule permettant de choisir l'extension PDF. (Par défaut je suis en .TIF ; mais je dois jongler avec 2 extensions..)

SI vous avez des idées,

Cordialement,

 

[fanch55]

Bonjour,
je n'ai pas compris l'intégralité de la demande .
Cependant si vous voulez tester vos liens, vous pouvez mettre la fonction ci-dessous dans un module :

Function IsLnkFile(Cell As Range)
    With Cell.Hyperlinks
        Select Case True
            Case .Count = 0:     IsLnkFile = CVErr(xlErrRef)
            Case .Item(1).Address <> ""
                Dim Fso As Object
                Set Fso = CreateObject("Scripting.FileSystemObject")
                    IsLnkFile = Fso.Fileexists(Cell.Value)
                Set Fso = Nothing
            Case Else
                IsLnkFile = CVErr(xlErrNA)
        End Select
    End With
End Function

Puis appelez la dans la cellule que vous voulez en indiquant la cellule contenant l'hyperlien :
=IsLnkFile(A2)

 

[Alex6942]

Bonjour,

Merci pour votre retour. Il est vrai qu'il manque des mots dans ma demande. Bizarre ..

Pour faire simple, j'ai des cellules avec des liens hypertextes dont la formule est : (pour exemple)

=LIEN_HYPERTEXTE(CONCATENER($P$1;C29;RECHERCHEV(C29;'EXPORT'!A:AA;27;FAUX));C29)

Cette formule va donc créer et chercher le nom de mon fichier à mettre en lien hypertexte.

Cependant je doit jongler entre 2 formats (TIF et PDF) , donc je souhaitais mettre en place un contrôle des liens du type : Si pas d'ouverture du fichier possible, alors renvoi d'une valeur dans une cellule (a la meme ligne sur le lien tester) du type : "Erreur format" qui par la suite me permettra d'ouvrir le même lien avec une extension pdf..


La fonction ci-dessus , me renvoi des #REF! ..

Cordialement,

 

[fanch55]

Bonjour,
C'est à dire que votre cellule va contenir le chemin et nom complet du fichier sans son extension ( .tif ou .pdf) ?

 

[job75]

Bonjour Alex6942, fanch55,

Les liens créés avec la fonction LIEN_YPERTEXTE ne sont pas des liens hypertextes.

La solution du post #2 ne convient donc pas.

A+

 

[Valtrase]

Salut à tous
avec cette fonction peut-être, elle renvoie True ou False selon si le lien est bon ou pas

Function TestHyper(Cellule As Range)
    ' // Quelques variables
Dim t
Dim i As Integer
If Cellule Is Nothing Then Set Cellule = ActiveCell
    With Cellule
        t = Split(.FormulaR1C1, """")
        If UBound(t) > 1 Then
            TestHyper = IIf(Dir(t(1)) <> "", True, False)
        Else
            TestHyper = False
        End If

    End With
End Function

 

[fanch55]

Bonjour Alex 6942, fanch55,

Les liens créés avec la fonction LIEN_YPERTEXTE ne sont pas des liens hypertextes.

La solution du post #2 ne convient donc pas.

A+

Tout à fait @job75 , celle-ci-dessous est adaptée mais par forcément à la demande :

Option Compare Text
Function IsLnkFile(Cell As Range)
Dim FileName As String
    With Cell
        Select Case True
            Case .Formula Like "*Hyperlink*"
                FileName = Cell.Value
            Case .Hyperlinks.Count = 0
                IsLnkFile = CVErr(xlErrRef): Exit Function
            Case .Hyperlinks.Item(1).Address = ""
                IsLnkFile = CVErr(xlErrNA): Exit Function
            Case ActiveWorkbook.BuiltinDocumentProperties("Hyperlink base") <> vbNullString
                ActiveWorkbook.BuiltinDocumentProperties("Hyperlink base") = vbNullString
                FileName = Cell.Hyperlinks.Item(1).Address
            Case Else
                FileName = Cell.Hyperlinks.Item(1).Address
        End Select
        Dim Fso As Object
        Set Fso = CreateObject("Scripting.FileSystemObject")
            IsLnkFile = Fso.Fileexists(FileName)
        Set Fso = Nothing
    End With
End Function

 

[job75]

Si les formules des liens sont toutes de la forme indiquée au post #3 (avec le 2ème argument pour la fonction LIEN_HYPERTEXTE) on peut tester le lien avec cette fonction VBA :

Function TesteLien$(c As Range)
Dim f$
f = c.Formula
If Not f Like "=HYPERLINK(*)" Then Exit Function
f = Mid(f, 12)
f = Left(f, InStrRev(f, ",") - 1)
TesteLien = "Le fichier du lien " & IIf(Dir(Evaluate(f)) = "", "n'existe pas", "existe")
End Function

Si la formule du lien est par exemple en A29 entrez en B29 =TesteLien(A29)

 

[Alex6942]

Si les formules des liens sont toutes de la forme indiquée au post #3 (avec le 2ème argument pour la fonction LIEN_HYPERTEXTE) on peut tester le lien avec cette fonction VBA :

Function TesteLien$(c As Range)
Dim f$
f = c.Formula
If Not f Like "=HYPERLINK(*)" Then Exit Function
f = Mid(f, 12)
f = Left(f, InStrRev(f, ",") - 1)
TesteLien = "Le fichier du lien " & IIf(Dir(Evaluate(f)) = "", "n'existe pas", "existe")
End Function

Si la formule du lien est par exemple en A29 entrez en B29 =TesteLien(A29)

Exactement , cela marche nickel.

Merci beaucoup.

 

[Alex6942]

Salut à tous
avec cette fonction peut-être, elle renvoie True ou False selon si le lien est bon ou pas

Function TestHyper(Cellule As Range)
    ' // Quelques variables
Dim t
Dim i As Integer
If Cellule Is Nothing Then Set Cellule = ActiveCell
    With Cellule
        t = Split(.FormulaR1C1, """")
        If UBound(t) > 1 Then
            TestHyper = IIf(Dir(t(1)) <> "", True, False)
        Else
            TestHyper = False
        End If

    End With
End Function

Salut , cela me renvoi FALSE dans tout les cas , alors que le liens marche

Merci de ton aide.