XL 2016 Bonsoir, je suis à la recherche d'un code qui me permettrait d'ouvrir un chemin reseau et de me renvoyer le lien hypertext sur le texte de la cellule.

christ77000

XLDnaute Occasionnel
Bonsoir, je suis à la recherche d'un code qui me permettrait d'ouvrir un chemin reseau et de me renvoyer le lien hypertext sur le texte de la cellule.

Chemin réseau en C1 de ma feuille "GC-2020"
..\..\Accidents%20&%20analyse%205%20pourquoi%20et%20arbres%20des%20causes\2020\

Donnée dans cellule C17:C57

exemple en C17 j'ai le mot "toto" je double clic dans la cellule et j'ai l'ouverture du chemin reseau dans l'explorer. je selectionne le fichier et il me renvoie sur le mot toto le lien hyperlink du fichier.

Merci pour votre aide.
 
Solution
C
Re,

Le choix du fichier retourne le chemin complet, il suffisait de supprimer le chemin initial

Voici
VB:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim MonDossier As String, MonFichier As String
  Cancel = True ' Evite d'entrée en mode esition dans la cellule
  If Not Application.Intersect(Target, Range("C18:C57")) Is Nothing Then
    MonDossier = "L:\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\2020" '<-- adaptez le nom du Dossier
    ' Vérifier l'anti-skash de fin
    If Right(MonDossier, 1) <> "\" Then MonDossier = MonDossier & "\"
    ' Vérifier l'existence du dossier, quoi que pas forcément nécessaire
    If Len(Dir(MonDossier...

christ77000

XLDnaute Occasionnel
et s'il n'y a rien dans la cellule et que je double clic ca affiche ca

Sans titre-5.jpg
 

christ77000

XLDnaute Occasionnel
Je viens d'éliminer un des problèmes, enfin je pense. Si je double clic sur une cellule vide. je n'ai plus l'erreur d'exécution 5, mais le lien qui s'affiche.

Sans titre-1.jpg


le premier lien en c32 juste par un double clic sur le fichier et le deuxième si j'annule il reste le lien vers les fichiers. je me suis rendu compte que lorsque je quitte le fichier et le relance et bien le double lien disparaît et qu'il fonctionne ?? la par contre je ne trouve pas de solution car je ne comprends pas tout le code.
du coup j'ai retirer la fin de cette ligne "ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=MonDossier & "\" & MonFichier ', TextToDisplay:=Selection.Value
 

job75

XLDnaute Barbatruc
Ah mais votre exemple avec "Films" m'éclaire, vous voulez faire une recherche.

Alors téléchargez ces 3 fichiers dans le même dossier (le bureau) et voyez cette macro :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [C18:C57]) Is Nothing Or Target(1) = "" Then Exit Sub
Dim fichier As Variant
Cancel = True
ChDir ThisWorkbook.Path 'dossier à adapter
fichier = Application.GetOpenFilename
If fichier <> False Then If InStr(LCase(fichier), LCase(Target)) Then Target.Hyperlinks.Add Target, fichier, TextToDisplay:=Target.Text
End Sub
 

Pièces jointes

  • Rechercher fichier(1).xlsm
    18 KB · Affichages: 5
  • Liste de films.xlsm
    9.6 KB · Affichages: 1
  • Liste de films.pdf
    69 KB · Affichages: 1

christ77000

XLDnaute Occasionnel
Merci pour l'aide, non pas de recherche dans les imprime écrans fournis on nous demande une description succincte, la réponse peut être et en fonction des personnes par exemples. fuite moteur x et le nom du fichier toto.xls. C'est une sorte de rapport électronique de nos problèmes de sécurité et autres. C'est juste une sélection de fichier a mettre en lien hypertexte sur fuite moteur x, tout comme le ferait le clic droit et lien hypertexte. En faite le fuite moteur x devient le nom du lien hypertext vers ce fichier toto.xls.
 
Dernière édition:

christ77000

XLDnaute Occasionnel
Bonsoir, je suis à la recherche d'un code qui me permettrait d'ouvrir un chemin reseau et de me renvoyer le lien hypertext sur le texte de la cellule.

Chemin réseau en C1 de ma feuille "GC-2020"
..\..\Accidents%20&%20analyse%205%20pourquoi%20et%20arbres%20des%20causes\2020\

Donnée dans cellule C17:C57

exemple en C17 j'ai le mot "toto" je double clic dans la cellule et j'ai l'ouverture du chemin reseau dans l'explorer. je selectionne le fichier et il me renvoie sur le mot toto le lien hyperlink du fichier.

Ce que j'avais expliquer lors de mon tout premier poste :rolleyes:
 
C

Compte Supprimé 979

Guest
Re,

Le choix du fichier retourne le chemin complet, il suffisait de supprimer le chemin initial

Voici
VB:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim MonDossier As String, MonFichier As String
  Cancel = True ' Evite d'entrée en mode esition dans la cellule
  If Not Application.Intersect(Target, Range("C18:C57")) Is Nothing Then
    MonDossier = "L:\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\2020" '<-- adaptez le nom du Dossier
    ' Vérifier l'anti-skash de fin
    If Right(MonDossier, 1) <> "\" Then MonDossier = MonDossier & "\"
    ' Vérifier l'existence du dossier, quoi que pas forcément nécessaire
    If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      MonFichier = ChoixFichier(MonDossier, "CHOIX du FICHIER", "*.*,*.*")
      ' Si MonFichier n'est pas vide
      If MonFichier <> "" Then
        ' S'il s'agit d'un lecteur réseau, inutile de mettre "file://"
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=MonFichier, TextToDisplay:=Selection.Value
      End If
    End If
  End If
End Sub

Function ChoixFichier(DefaultPath As String, sTitre As String, Optional sFilter As String)
  ' LE filtre doit être du type : "BdD Communes (*.xlsx), *.xlsx"
  Dim fd As FileDialog, TabFilter() As String
  ' Initialiser les variables
  If Right(DefaultPath, 1) <> "\" Then DefaultPath = DefaultPath & "\"
  ' Initialiser l'intance du dialogue
  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
    .Filters.Clear
    ' Si un filtre a été donné
    If sFilter <> "" Then
      TabFilter = Split(sFilter, ",")
      .Filters.Add TabFilter(0), Trim(TabFilter(1))
    End If
    .Title = sTitre
    .InitialFileName = DefaultPath & TabFilter(0)
    If .Show = -1 Then
      ChoixFichier = fd.SelectedItems(1)
    End If
  End With
  Set fd = Nothing
End Function
 

job75

XLDnaute Barbatruc
Si l'on veut filtrer les fichiers du dossier affiché il faut en effet utiliser Application.FileDialog :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [C18:C57]) Is Nothing Or Target(1) = "" Then Exit Sub
Dim chemin$
Cancel = True
chemin = ThisWorkbook.Path 'dossier à adapter
ChDir chemin
With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = chemin & "\*" & Target & "*"
    .Filters.Clear
    .Filters.Add "Tous les fichiers", "*.*"
    .AllowMultiSelect = False
    If .Show Then Target.Hyperlinks.Add Target, .SelectedItems(1), TextToDisplay:=Target.Text
End With
End Sub
Fichier (2).
 

Pièces jointes

  • Rechercher fichier(2).xlsm
    19 KB · Affichages: 4
  • Liste de films.xlsm
    9.6 KB · Affichages: 2
  • Liste de films.pdf
    69 KB · Affichages: 1