Bonjour,
Je voudrais placer un lien hypertexte sur un nom de fichier par vba.
En colonne D je tape le nom du fichier.
Comment placer un lien hypertexte sur ce fichier.
Voici ce que j'ai commenc=E9 =E0 =E9crire:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then
derligne =3D Range("D500").End(xlUp).Row
NomFichier =3D "DP" & Range("D" & derligne) & ".xls"
ActiveSheet.Hyperlinks.Add Anchor:=3DNomFichier, Address:=3D"D:\CTX\FIN=
ANCIER\DEMANDES MATERIAUX\DP 2014\" _
, TextToDisplay:=3DNomFichier
=20
End If
End Sub
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then DerLig = Range("D500").End(xlUp).Row Fichier = "DP" & Range("D" & DerLig) & ".xls" If Dir(Chemin & Fichier) <> "" Then Me.Hyperlinks.Add Anchor:=NomFichier, _ Address:="D:CTXFINANCIERDEMANDES MATERIAUXDP 2014" _ , TextToDisplay:=NomFichier Else MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _ "répertoire """ & Chemin & """." End If End If
End Sub
Bonjour,
Et comme ceci :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLig As Long, Fichier As String
Dim Chemin As String
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then
DerLig = Range("D500").End(xlUp).Row
Fichier = "DP" & Range("D" & DerLig) & ".xls"
If Dir(Chemin & Fichier) <> "" Then
Me.Hyperlinks.Add Anchor:=NomFichier, _
Address:="D:CTXFINANCIERDEMANDES MATERIAUXDP 2014" _
, TextToDisplay:=NomFichier
Else
MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _
"répertoire """ & Chemin & """."
End If
End If
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then DerLig = Range("D500").End(xlUp).Row Fichier = "DP" & Range("D" & DerLig) & ".xls" If Dir(Chemin & Fichier) <> "" Then Me.Hyperlinks.Add Anchor:=NomFichier, _ Address:="D:CTXFINANCIERDEMANDES MATERIAUXDP 2014" _ , TextToDisplay:=NomFichier Else MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _ "répertoire """ & Chemin & """." End If End If
End Sub
JP
Bonsoir Denis,
J'ai une erreur d'exécution 13 avec le message "Incompatibilité de type " sur la ligne suivante.
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then DerLig = Range("D500").End(xlUp).Row Fichier = "DP" & Range("D" & DerLig) & ".xls" If Dir(Chemin & Fichier) <> "" Then Me.Hyperlinks.Add Anchor:=Me.Range("A5"), _ Address:= Chemin & Fichier, _ TextToDisplay:=Chemin & Fichier Else MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _ "répertoire """ & Chemin & """." End If End If
End Sub '----------------------------------------------------
'----------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLig As Long, Fichier As String
Dim Chemin As String
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then
DerLig = Range("D500").End(xlUp).Row
Fichier = "DP" & Range("D" & DerLig) & ".xls"
If Dir(Chemin & Fichier) <> "" Then
Me.Hyperlinks.Add Anchor:=Me.Range("A5"), _
Address:= Chemin & Fichier, _
TextToDisplay:=Chemin & Fichier
Else
MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _
"répertoire """ & Chemin & """."
End If
End If
End Sub
'----------------------------------------------------
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then DerLig = Range("D500").End(xlUp).Row Fichier = "DP" & Range("D" & DerLig) & ".xls" If Dir(Chemin & Fichier) <> "" Then Me.Hyperlinks.Add Anchor:=Me.Range("A5"), _ Address:= Chemin & Fichier, _ TextToDisplay:=Chemin & Fichier Else MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _ "répertoire """ & Chemin & """." End If End If
End Sub '----------------------------------------------------
JP
Bonjour Denis,
Le changement d'heure ne te gêne pas à priori vu l'heure à laquelle t u as répondu. Juste une dernière chose. Quand je clique sur le lien hypertexte créé, Excel me demande si je veu x activer les macros du fichier. Comment éviter cette question dans la mesure ou je peux attester de l'int égrité du fichier? (j'en suis l'auteur)
Pour le moment voici le code commenté pour ceux qui pourraient être int éressés. J'ai fait quelques modifications de ta proposition.
JP
Private Sub Worksheet_Change(ByVal Target As Range)
'déclaration des variables Dim DerLig As Long, Fichier As String Dim Chemin As String, Cell As Variant
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then
Chemin = ActiveWorkbook.Path & "" 'chemin du dossier actif Application.EnableEvents = False ' désactive temporairement la macr o événementielle DerLig = Range("D500").End(xlUp).Row ' trouve la dernière cellule écrite de la colonne D Cell = Range("D" & DerLig).Address ' mémorise l'adresse de la cellu le où doit s'écrire le lien Fichier = "DP" & Range("D" & DerLig) & ".xls" ' nom du fichier
'message si le fichier n'est pas trouvé MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _ "répertoire """ & Chemin & """." End If End If
Application.EnableEvents = True 'réactive la macro événementielle
End Sub
Bonjour Denis,
Le changement d'heure ne te gêne pas à priori vu l'heure à laquelle t u as répondu.
Juste une dernière chose.
Quand je clique sur le lien hypertexte créé, Excel me demande si je veu x activer les macros du fichier.
Comment éviter cette question dans la mesure ou je peux attester de l'int égrité du fichier? (j'en suis l'auteur)
Pour le moment voici le code commenté pour ceux qui pourraient être int éressés. J'ai fait quelques modifications de ta proposition.
JP
Private Sub Worksheet_Change(ByVal Target As Range)
'déclaration des variables
Dim DerLig As Long, Fichier As String
Dim Chemin As String, Cell As Variant
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then
Chemin = ActiveWorkbook.Path & "" 'chemin du dossier actif
Application.EnableEvents = False ' désactive temporairement la macr o événementielle
DerLig = Range("D500").End(xlUp).Row ' trouve la dernière cellule écrite de la colonne D
Cell = Range("D" & DerLig).Address ' mémorise l'adresse de la cellu le où doit s'écrire le lien
Fichier = "DP" & Range("D" & DerLig) & ".xls" ' nom du fichier
'message si le fichier n'est pas trouvé
MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _
"répertoire """ & Chemin & """."
End If
End If
Application.EnableEvents = True 'réactive la macro événementielle
Le changement d'heure ne te gêne pas à priori vu l'heure à laquelle t u as répondu. Juste une dernière chose. Quand je clique sur le lien hypertexte créé, Excel me demande si je veu x activer les macros du fichier. Comment éviter cette question dans la mesure ou je peux attester de l'int égrité du fichier? (j'en suis l'auteur)
Pour le moment voici le code commenté pour ceux qui pourraient être int éressés. J'ai fait quelques modifications de ta proposition.
JP
Private Sub Worksheet_Change(ByVal Target As Range)
'déclaration des variables Dim DerLig As Long, Fichier As String Dim Chemin As String, Cell As Variant
If Not Intersect(Target, Range("D5:D505")) Is Nothing Then
Chemin = ActiveWorkbook.Path & "" 'chemin du dossier actif Application.EnableEvents = False ' désactive temporairement la macr o événementielle DerLig = Range("D500").End(xlUp).Row ' trouve la dernière cellule écrite de la colonne D Cell = Range("D" & DerLig).Address ' mémorise l'adresse de la cellu le où doit s'écrire le lien Fichier = "DP" & Range("D" & DerLig) & ".xls" ' nom du fichier
'message si le fichier n'est pas trouvé MsgBox "Aucun fichier correspond à """ & Fichier & """ dans ce " & _ "répertoire """ & Chemin & """." End If End If
Application.EnableEvents = True 'réactive la macro événementielle
Dans les options d'Excel / Centre de gestion de la confidentialité / Bouton : Paramètres du centre de gestion de la confidentialité / il y a un amalgame d'options regardant la sécurité... selon le niveau de sécurité que tu veux appliquer.
Exemple : Emplacements approuvés : Tu peux ajouter un répertoire où se retrouvent lesdits documents.
Dans les options d'Excel / Centre de gestion de la confidentialité / Bouton
: Paramètres du centre de gestion de la confidentialité /
il y a un amalgame d'options regardant la sécurité... selon le niveau de
sécurité que tu veux appliquer.
Exemple : Emplacements approuvés : Tu peux ajouter un répertoire où se
retrouvent lesdits documents.
Tu peux signer numériquement le projet macro : Voir comment faire à cette
adresse comment procéder :
http://office.microsoft.com/fr-ca/excel-help/signer-numeriquement-votre-projet-macro-HA010354312.aspx
Dans les options d'Excel / Centre de gestion de la confidentialité / Bouton : Paramètres du centre de gestion de la confidentialité / il y a un amalgame d'options regardant la sécurité... selon le niveau de sécurité que tu veux appliquer.
Exemple : Emplacements approuvés : Tu peux ajouter un répertoire où se retrouvent lesdits documents.