Générer Lien hypertexte en VBA

Bonjour

En relisant le fil, le nom du fichier se termine bien par CLIE_B7590.pdf ou CLIE_B7950.pdf ?

Cette question parce que je vois que dans l'échange de post on parle de ces deux références. Vérifiez dans le code Double-Click

Vous avez essayé avec les deux codes Trouvefichier et Trouvefichier2003 ?
Vous utilisez bien le même fichier que celui posté ?

Bonsoir Dan,

Bien vu, je regarde cela rapidement. Il est vrai que le nommage peut évoluer d'une année à l'autre... La seule partie qui est fixe est l'identifiant indiqué dans les cellules de la colonne B qui lui est unique. Du coup ne serait-il pas judicieux de rechercher le dossier dans lequel le fichier PDF est nommé en partie cet identifiant et ne pas prendre en compte le reste du nommage qui peut varier.

Bonne soirée.

Bonjour

La seule partie qui est fixe est l'identifiant indiqué dans les cellules de la colonne B qui lui est unique. Du coup ne serait-il pas judicieux de rechercher le dossier dans lequel le fichier PDF est nommé en partie cet identifiant

Vous parlez bien de CLIE_7950 qui est fixe ?

En attendant votre retour sur la recherche

Bonsoir Dan,

Je n'ai pas eu le temps de regarder la macro aujourd'hui. Je m'en occupe demain à la première heure.

Pour répondre à votre question, CLIE_7950 est bien la partie connue mais elle varie en fonction de l'année en cours et elle est définie par l'entreprise qui génère les fichiers. La partie unique du fichier est renvoyée par la valeur Target. Le fichier sera toujours nommé par la valeur Target puis par une partie fixe pour 2021 qui est CLIE_7950 mais pour 2020 qui était CLIE_6789. Bref la seule partie unique et connue à coup sûr est la valeur Target renvoyée par le double clic. Donc si on pouvait chercher le dossier dans lequel se situe le fichier composé en partie par la valeur Target sans tenir compte du reste du nommage cela éviterait les erreurs de saisie des parties fixes (CLIE_7950).

Bonne fin de journée.

Bonsoir Dan,

Jai vérifié le nommage fixe connu, il était correct. Donc quand le fichier existe si je double clic sur la cellule de la colonne B alors un dossier s'ouvre mais ce n'est pas le bon il s'agit de mes documents\ dans lequel se trouve une second dossier --> mes sources de données... Alors que le fichier n'est pas du tout dans le dossier mes documents...

Si le fichier n'existe pas aucune fenêtre ne s'ouvre.

Bonne fin de journée.

Bonjour,

On va tester autrement.

1. Dans la feuille TRAME, mettez ce code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Annee = Year(Range("C" & Target.Row))
    NomFichier = Target & "*.pdf" '& "_CLIE_B7590.pdf"
    Call ChercherFichiers
End If
Cancel = True
End Sub

2. Dans un module, mettez ces deux codes

Public NomFichier As String
Public Annee As Long
Sub ChercherFichiers()
Dim Chemin As String

Chemin = "T:\0\Email\" & Annee & "\Inovalys\" & Annee & "_Rapports_Analyses\"
'Chemin = ThisWorkbook.Path & "\"
'Appelle la procédure de recherche des fichiers
TrouverFichiers Chemin

End Sub

Sub TrouverFichiers(Chemin)

'Activez la référence "Microsoft Scripting RunTime"

Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File

Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Chemin)

'Boucle sur fichiers du répertoire
For Each FileItem In SourceFolder.Files
    If FileItem.Name Like NomFichier Then
    'If NomFichier = FileItem.Name Then
        If Len(Dir(SourceFolder, vbDirectory)) > 0 Then 'vérifie si le Dossier existe
            Shell Environ("WINDIR") & "\explorer.exe " & SourceFolder, vbNormalFocus
        End If
   Exit Sub
   End If
Next FileItem

'--- Appel pour fichiers dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
    TrouverFichiers SubFolder.Path
    Next SubFolder
End Sub

3. Dans le menu Outils --> References de l'éditeur VBA, allez activer le complément "Microsoft Scripting Runtime"

NB : Les variables Public doivent être placées en début du module (donc sur les lignes 1 et 2)

Cela fonctionne sous Excel 2016. Pour le test, j'ai placé le fichier dans un répertoire et le fichier à trouver dans un sous / sous répertoire. La recherche se fait sur base du nom de fichier mentionné dans la feuille TRAME en considérant que son extension est PDF

Bonjour Dan,

Merci pour le travail effectué qui fonctionne parfaitement. Cela répond en tout point à ma demande.

Quand le fichier n'est pas trouvé est il possible de rajouter la MsgBox ?

Si un jour une montée de version vers Excel 365 se fait, ce code fonctionnera t'il aussi.

Bonne journée

Cordialement.

Quand le fichier n'est pas trouvé est il possible de rajouter la MsgBox ?

Oui. Il faut modifier les codes

1. Dans la feuille TRAME

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Annee = Year(Range("C" & Target.Row))
    NomFichier = Target & "*.pdf" '& "_CLIE_B7590.pdf"
    FichierTrouve = False
    Call ChercherFichiers 'Trouvefichier
End If
Cancel = True
If FichierTrouve = False Then MsgBox "Fichier non trouvé !"
End Sub

2. Dans un module, remplacez les deux codes par ces deux-ci

Public NomFichier As String
Public Annee As Long
Public FichierTrouve As Boolean

Sub ChercherFichiers()
Dim Chemin As String

Chemin = "T:\0\Email\" & Annee & "\Inovalys\" & Annee & "_Rapports_Analyses\"
'Appelle la procédure de recherche des fichiers
TrouverFichiers Chemin
End Sub

Sub TrouverFichiers(Chemin)
'Activer la référence "Microsoft Scripting RunTime"
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File

Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Chemin)

'Boucle sur fichiers du répertoire
For Each FileItem In SourceFolder.Files
    If FileItem.Name Like NomFichier Then
    'If NomFichier = FileItem.Name Then
        If Len(Dir(SourceFolder, vbDirectory)) > 0 Then 'vérifie si le Dossier existe
            FichierTrouve = True
            Shell Environ("WINDIR") & "\explorer.exe " & SourceFolder, vbNormalFocus
            Exit Sub
        End If
   End If
Next FileItem

'--- Appel pour fichiers dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
    TrouverFichiers SubFolder.Path
Next SubFolder
End Sub

3. Si un jour une montée de version vers Excel 365 se fait, ce code fonctionnera t'il aussi.

Oui je l'ai testé avec cette version

Bonsoir Dan,

Merci pour ces éléments - ça fonctionne au top.

Si le répertoire ou le nom du dossier n'existe pas, cela renvoie un code erreur macro (run time error '76' Path not found") - cela m'indique donc que le dossier n'a pas été créé ou pas au bon endroit par la personne qui aurait dû le faire.

Bonne soirée et merci de votre aide précieuse.

Cordialement,

Bonjour

Cordialement

Bonjour,

C'est fait.

@+ et merci.

Cordialement