Automatiser des liens hypertextes excel avec VBA

Question

Bonjour &#224; touts et &#224; toutes,


D&#233;butant dans VBA, pourriez me d&#233;panner?


J'ai un fichier excel avec un menu qui pointe vers d'autres fichiers excel qui se trouve dans des repertoires de mon disque C: . La liaison entre les diff&#233;rent fichier excel se fait via des liens hypertextes.
Mon probl&#232;me c'est:
- si je d&#233;place certains fichiers excel dans un autre repertoire par exemple le d:, je perds les liens. Je suis oblig&#233; de changer manuellement mes liens hypertexte entre mon fichier menu et les fichiers d&#233;plac&#233;s.


Existe-til une soliution en vba ? Mon but c'est quand je clique sur un bouton dans mon fichier excel menu, je voudrai que le chemin du fichier excel de pointage soit calcul&#233; et retrouv&#233; dynamiquement, sans que j'ai a remodifier manuellment les liens hypertexte de mes fichiers excel.


Merci d'avance pour vos suggestions.

mrdep1978 · Answer

La grosse difficult&#233; de ton probl&#232;me est qu'il faudrait pouvoir trouver le r&#233;pertoire dans lequel tu as d&#233;plac&#233; ton fichier cible. Ca peut s'av&#233;rer long de parcourir tout le disque pour le retrouver, et de plus, si tu as 2 fichiers du m&#234;me nom, lequel choisir ?

Je te propose tjs &#231;a :

Sub gsub_test()
Dim lh As Hyperlink
Dim li_pos As Integer
Dim ls_File As String
Dim i As Integer
Dim li_reponse As Integer
For Each lh In Hyperlinks
    'Extrait le nom du fichier &#224; partir du nom complet point&#233; par le lien
    li_pos = Len(lh.Address) - InStrRev(lh.Address, "")
    ls_File = Right(lh.Address, li_pos)
    
    With Application.FileSearch
        'Cherche ce fichier
        .Filename = ls_File
        'Parcourt tout le C:
        .LookIn = "c:"
        .SearchSubFolders = True    'Parcourt des sous-r&#233;pertoires
        .Execute
        'D&#233;termine le nb de fichiers trouv&#233;s
        If .FoundFiles.Count > 1 Then
            'Si il y a plusieurs fichiers, on propose chaque fichier
            For i = 1 To .FoundFiles.Count
                li_reponse = MsgBox("Choisir :" & vbCrLf & .FoundFiles(i), vbYesNo)
                If li_reponse = vbYes Then
                    'Si un fichier est choisi, on l'affecte au lien
                    lh.Address = .FoundFiles(i)
                    Exit For
                End If
            Next i
        Else
            'Affecte au lien si un seul fichier trouv&#233;            If .FoundFiles.Count 1 Then lh.Address .FoundFiles(i)
        End If
    End With
Next lh

Automatiser des liens hypertextes excel avec VBA

1 réponse

Discussions similaires