Erreur sur lien hypertexte

Bonjour

J'ai un fichier avec des liens hypertextes.

Comme nous sommes en réseau et que nous sommes plusieurs utilisateurs, l'adresse du lien contient le nom de l'utilisateur habilité.

Les liens sont donc reconstruits via une macro associée à l'évènement worksheet_selectionchange, chaque fois que l'on clique sur la cellule associée au lien.

Toutefois, lorsque l'utilisateur clique directement sur le lien (sans sélection préalable de la cellule), l'ouverture du lien se fait avant la reconstruction du lien et un message d'erreur apparaît disant que le lien n'est pas valide. Il faut donc cliquer une deuxième fois sur le lien une fois celui-ci reconstruit.

J'aimerais que lors de l'ouverture du lien, le message d'erreur soit supprimé et que le lien soit réouvert une fois reconstruit.

L'évènement worksheet_followhyperlink ne se réalise qu'après l'ouverture du lien,

application.Displayalerts= false ne fonctionne pas, ou je ne sais pas où le disposer.

Avez-vous une piste pour désactiver l'alerte et reconstruire le lien puis l'ouvrir?

Merci d'avance

Etienne

Bonjour, Si vos liens sont construits sur la base du nom d'utilisateur ; alors l'évènement

worksheet_change () n'est sans doute pas adapté.

Pourquoi ne pas déplacer votre code dans : la partie Workbook ainsi les liens seraient reconstruits à l'ouverture du fichier.

Private Sub Workbook_Open()

End Sub

Vous pourriez aussi utiliser une cellule de référence pour le nom d'utilisateur qui se mettrait à jour dès l'ouverture.

Ainsi vos lien prendraient cette cellule comme nom d'utilisateur à l'ouverture.

Bonjour et merci

Je vais essayer, car j'ai déjà une macro pour faire tous les liens d'une table

Toutefois, je crains que l'ouverture devienne longue car il s'agit d'un fichiers contenant une table par année qui lui même contient des centaines d'enregistrements.

La plupart du temps, les utilisateurs travaillent sur le fichiers via un formulaire, et il y a un bouton pour ouvrir le lien. Dans ce cas, le lien est reconstruit sans problème puis s'ouvre sans erreur.

Le problème apparaît lorsque l'on travaille en direct sur la feuille, ce que certains collaborateurs préfèrent.

Votre deuxième proposition avec une cellule contenant le nom d'utilisateur me paraît fort judicieuse car sa mise à jour serait brève, mais dans ce cas, dois-je nécessairement passer par la fonction lien_hypertexte?

Il faudrait voir actuellement comment votre bouton reconstruit le lien hypertexte

la macro est la suivante:

Sub recherche_adresse_fichier(LeDossier$, Idx As Long, rng As Range)
On Error GoTo fin
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object
Set fso = CreateObject("Scripting.FileSystemObject")


Set Dossier = fso.GetFolder(LeDossier)

For Each Flder In Dossier.subfolders
Idx = Idx + 1
If Len(Dir(Flder.Path & "\" & rng.Text & ".pdf")) > 0 Then

rng.Worksheet.Hyperlinks.Add rng, Flder.Path & "\" & rng.Text & ".pdf"
Exit Sub

End If
Next

For Each sousRep In Dossier.subfolders
recherche_adresse_fichier sousRep.Path, Idx, rng
Next sousRep
Set fso = Nothing

Exit Sub
fin:
End Sub

Salut,

Testes si ça te convient:

1. Dans un module tu crée une fonction recherche_adresse_fichier(LeDossier$, Idx As Long, rng As Range)
2. Dans la cellule du lien hypertexte tu fais référence à ta fonction =recherche_adresse_fichier("C:\",100,Range("A15"))
3. Tu fais pointer ton lien hypertexte sur la cellule qui le contient.

Là je pense que l'on devrait être bon...

Bonjour,

Je poste juste ça là car je sais que c'est possible, pour alléger le workbook_open, on limite à une feuille comme à priori vous en avez plein. Donc dans le code de ThisWorkbook, l'évènement SheetChange :

- On vérifie si le lien hypertexte de la première cellule de la feuille qui vient d'être activée contenant un lien hypertexte contient le nom de l'utilisateur
- Si oui alors on ne fait rien
- Si non alors on update tous les hyperlinks de la feuille activée avec l'user

Ca évite d'updater toutes les feuilles en se limitant à la feuille active et vous permet de conserver votre Selection_Change sur votre feuille. En effet le Sheet_Change aura updaté les hyperlinks avant que vous ne cliquiez sur une cellule, sauf si vous vous trouvez déjà sur la feuille active, auquel cas il faudra un bout de code sur le Workbook_Open en se limitant à l'update des hyperlinks de la feuille active.

Après il est vrai qu'avoir une colonne avec tous les hyperlinks lié à une cellule contenant le chemin et le nom du user ça peut être pratique.

Cdlt,

Bonjour Jean Paul et Ergotine et merci pour votre aide

@Jean Paul

J'ai créé la fonction suivante dans un module:

Function recherche_adresse_fichier2(LeDossier$, Idx As Long, nom_doc As String) as string
On Error GoTo fin
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object
Set fso = CreateObject("Scripting.FileSystemObject")


Set Dossier = fso.GetFolder(LeDossier)
'examen du dossier courant
For Each Flder In Dossier.subfolders
Idx = Idx + 1
If Len(Dir(Flder.Path & "\" & nom_doc & ".pdf")) > 0 Then

recherche_adresse_fichier2 = Flder.Path & "\" & nom_doc & ".pdf"
Exit Function

End If
Next
'traitement récursif des sous dossiers
For Each sousRep In Dossier.subfolders
recherche_adresse_fichier2 sousRep.Path, Idx, nom_doc
Next sousRep
Set fso = Nothing

Exit Function
fin:
End Function

Ensuite, je tape la fonction avec les arguments dans une cellule, mais elle renvoit "0" pour des liens que ma procédure sub trouve. Je suppose que j'ai commis une erreur.

Par ailleurs je ne comprends pas pourquoi dans votre exemple, vous mettez l'argumen IDX à 100 et pas 1.

@ ergotine

Je vais tester votre solution et voir le temps de l'actualisation.

Encore merci

Salut,

Le 100 est tapé à la volée...

Pour ton code je verrais plutôt quelque chose dans ce style :

Là on ne cherche que dans les sous dossiers directs ne connaissant pas l’architecture de tes dossiers. Sinon faut faire du récursif.

Function recherche_adresse_fichier2(SearchFullPath As String, nom_doc As String) As String
    Set fso = New Scripting.FileSystemObject
    Dim Fld As Folder
    Dim fl

    On Error GoTo recherche_adresse_fichier2_Error

    strTemp = SearchFullPath & IIf(Right(SearchFullPath, 1) <> "\", "\", "") & nom_doc & ".pdf"
    '// On se cale sur le dossier
    Set Fld = fso.GetFolder(SearchFullPath)

    If fso.FileExists(strTemp) Then
        recherche_adresse_fichier2 = strTemp
        GoTo recherche_adresse_fichier2_Exit
    End If

    For Each fl In Fld.SubFolders
        With fl
            strTemp = .Path & IIf(Right(.Path, 1) <> "\", "\", "") & nom_doc & ".pdf"
            If Dir(strTemp) <> "" Then
                recherche_adresse_fichier2 = strTemp
                GoTo recherche_adresse_fichier2_Exit
            End If
        End With
    Next

recherche_adresse_fichier2_Exit:
    '// On nettoie la mémoire
    If Not fso Is Nothing Then Set fso = Nothing
    If Not Fld Is Nothing Then Set Folders = Nothing

    Exit Function

recherche_adresse_fichier2_Error:
    MsgBox "Erreur " & Err.Number & " (" & Err.Description & ") dans la procédure recherche_adresse_fichier2 du Module Module1"

    Resume recherche_adresse_fichier2_Exit
End Function