Lien hypertexte: n'afficher que les liens valides

Fermé
Tartartom Messages postés 11 Date d'inscription jeudi 20 août 2009 Statut Membre Dernière intervention 19 mars 2014 - Modifié par Tartartom le 18/03/2014 à 08:20
Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 - 19 mars 2014 à 11:36
Bonjour,

Nous avons un tableau Excel crée à partir d'une extraction d'un autre logiciel.

Ce tableau sert de base à un inventaire et nous avons créé des colonnes supplémentaires pointant vers les photos de l'élément physique correspondant.

Pour ce faire j'ai une utilisé cette formule :

=SI($K14="";"";LIEN_HYPERTEXTE(CONCATENER("CHEMIN DU DOSSIER\";$A14+P$2;".jpg");$A14+P$2))

Le nom usuel obtenu est la somme de deux nombre : l'un étant la référence, l'autre étant utilisé pour distinguer dans quelle catégorie d'information visuelle on va trouver et ceci permet de ranger les photos correctement dans le dossier.

Mon problème est que les liens crées renvois systématiquement un numéro dans la case.

Cependant j'aimerais n'afficher que les numéros ayant un lien valide. Ou crée une macro qui test les liens et supprime le numéro.

J'espère avoir énoncé mon problème clairement...

Je joins un mini exemple :
https://www.cjoint.com/?DCsirTlwc0j

Merci d'avance,

Tartar



1 réponse

Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 149
18 mars 2014 à 09:43
Bonjour,

J'ai fait une macro complémentaire un jour sur ce sujet, mais je ne l'ai pas sous la main...
Il semble y avoir des choses intéressantes sur le sujet par ailleurs : https://www.developpez.net/forums/d1361862/logiciels/microsoft-office/excel/macros-vba-excel/tester-liens-hypertextes/

A+
0
Tartartom Messages postés 11 Date d'inscription jeudi 20 août 2009 Statut Membre Dernière intervention 19 mars 2014
18 mars 2014 à 11:21
Merci de ton aide mais je ne m'y connais pas trop en VBA.

J'ai beau essayer de comprendre sa ne passe pas la.

J'ai déja essayer avec une fonction type :
Function ExisteFichier(nomfic As String) As Boolean
ExisteFichier = (Dir(nomfic) <> "")
End Function

trouvé sur cette page :
https://forums.commentcamarche.net/forum/affich-20066803-fonction-pour-tester-lien-hypertexte-excel

Mais ceci me renvoi la valeur faux ou vrai m^me si le lien ne pointe vers aucun document.
0
Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 149
18 mars 2014 à 11:44
vrai m^me si le lien ne pointe vers aucun document

Ajoute Application.Volatile juste en-dessous de la déclaration de fonction
Tu es sûr que le texte dans la cellule est le même que l'adresse du lien ?
0
Tartartom Messages postés 11 Date d'inscription jeudi 20 août 2009 Statut Membre Dernière intervention 19 mars 2014
Modifié par Tartartom le 18/03/2014 à 11:56
Non le texte de la cellule n'affiche pas G:/...... mais seulement le nom du document.
*J'avai aussi essayer avec application volatile qui sert à "rafraichir" chaque fois.

j'utilise dans une colonne adjacente:
=SI(ExisteFichier(Q9);FAUX;VRAI)

Avec :
Function ExisteFichier(nomfic As String) As Boolean
Application.Volatile
ExisteFichier = (Dir(nomfic) <> "")
End Function


Cependant il renvoi vrai tant qu'il y à du texte.
0
Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 149
18 mars 2014 à 11:58
Ben ta fonction VBA utilise le texte de la cellule et pas le lien pointé, ça ne peut pas marcher...
J'ai remis la main sur mon travail d'il y a qqs années.
Colle ceci sous VBA Editor sélectionne toute la plage où il y a des liens et exécute "liens_valides" (ça marche apparemment aussi avec des adressages relatifs) :

Sub liens_valides()
For Each c In Selection
    c.Select
    test_lien
Next c
End Sub

Function test_lien()

Dim Plage As Range

Set Plage = ActiveCell
        On Error GoTo erreur:
        Fichier = Plage.Hyperlinks.Item(1).Address

        ' Cas de l'adressage relatif dans les liens hypertextes
        If Left(Fichier, 3) = "../" Then Dossier1 = ActiveWorkbook.Path

        While Left(Fichier, 3) = "../"
            Fichier = Right(Fichier, Len(Fichier) - 3) 'ActiveWorkbook.path & "/" & Fichier
            While Right(Dossier1, 1) <> "\" And Right(Dossier1, 1) <> "/"
                Dossier1 = Left(Dossier1, Len(Dossier1) - 1)
            Wend
                Dossier1 = Left(Dossier1, Len(Dossier1) - 1)
        Wend
        If Dossier1 <> "" Then Fichier = Dossier1 & "/" & Fichier
        ' Fin de ce cas ; à ce stade, "Fichier" donne l'adresse complète du fichier joint

        If Dir(Fichier) <> "" Then
            'MsgBox "Le fichier que vous allez joindre est :" & Chr(10) & Fichier
            Plage.Interior.ColorIndex = 43
        Else
            'MsgBox "Le lien hypertexte n'est pas valide"
            Plage.Interior.ColorIndex = 46
        End If
'.Pattern = xlSolid
'.PatternColorIndex = xlAutomatic
erreur:
End Function
0
Tartartom Messages postés 11 Date d'inscription jeudi 20 août 2009 Statut Membre Dernière intervention 19 mars 2014
18 mars 2014 à 12:07
Merci,
je vais essayer mais ce site ne facilite pas la tâche je doit prendre bout à bout tes ligne pour les copier!
0