VBA Excel
Résolu
bvitalis
Messages postés
3
Date d'inscription
lundi 29 septembre 2003
Statut
Membre
Dernière intervention
29 août 2005
-
29 août 2005 à 11:37
bvitalis Messages postés 3 Date d'inscription lundi 29 septembre 2003 Statut Membre Dernière intervention 29 août 2005 - 29 août 2005 à 12:34
bvitalis Messages postés 3 Date d'inscription lundi 29 septembre 2003 Statut Membre Dernière intervention 29 août 2005 - 29 août 2005 à 12:34
2 réponses
mrdep1978
Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
7
29 août 2005 à 12:28
29 août 2005 à 12:28
Salut,
Il suffit de le mettre dans l'événement SelectionChange
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Filters.Clear
fd.Filters.Add "Excel *.xls", "*.xls"
fd.Show
If fd.SelectedItems.Count > 0 Then Target.Value = fd.SelectedItems(1)
End Sub
Il suffit de le mettre dans l'événement SelectionChange
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Filters.Clear
fd.Filters.Add "Excel *.xls", "*.xls"
fd.Show
If fd.SelectedItems.Count > 0 Then Target.Value = fd.SelectedItems(1)
End Sub
bvitalis
Messages postés
3
Date d'inscription
lundi 29 septembre 2003
Statut
Membre
Dernière intervention
29 août 2005
29 août 2005 à 12:34
29 août 2005 à 12:34
merci de ton aide,
j'en étais arrivé a cette solution en me balladant sur le forum
voila le resultat si ca peut aider qqn
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Result_FullFileName As String
Dim Result_FileRep As String
Dim Result_FileName As String
Dim iC As Integer
Dim iR As Integer
Dim OldValue As String
iC = Target.Column ' colonne de la cellule active
iR = Target.Row ' ligne de la cellule active
OldValue = Target.Value ' valeur de la cellule active
If (iC = 1 And iR >= 3) Then
' Si il s'agit d une cellule de la premier colonne et une ligne à partir de la ligne 3
' Activation de la recherche de fichier Excel dans le meme repertoire que le classeur
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Filters.Clear
fd.Filters.Add "Excel *.xls", "*.xls"
fd.Show
If (fd.SelectedItems.Count = 1) Then
' si un et un seul fichier a ete selectionné
' recuperation simplement du nom de fichier sans repertoire
Result_FullFileName = fd.SelectedItems.Item(1)
Result_FileRep = fd.InitialFileName
Result_FileName = Replace(Result_FullFileName, Result_FileRep, "")
Else
' sinon on laisse l ancienne valeur de la cellule
Result_FileName = OldValue
End If
' mise a jour de la valeur de la cellule
Selection.FormulaR1C1 = Result_FileName
End If
End Sub
j'en étais arrivé a cette solution en me balladant sur le forum
voila le resultat si ca peut aider qqn
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Result_FullFileName As String
Dim Result_FileRep As String
Dim Result_FileName As String
Dim iC As Integer
Dim iR As Integer
Dim OldValue As String
iC = Target.Column ' colonne de la cellule active
iR = Target.Row ' ligne de la cellule active
OldValue = Target.Value ' valeur de la cellule active
If (iC = 1 And iR >= 3) Then
' Si il s'agit d une cellule de la premier colonne et une ligne à partir de la ligne 3
' Activation de la recherche de fichier Excel dans le meme repertoire que le classeur
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Filters.Clear
fd.Filters.Add "Excel *.xls", "*.xls"
fd.Show
If (fd.SelectedItems.Count = 1) Then
' si un et un seul fichier a ete selectionné
' recuperation simplement du nom de fichier sans repertoire
Result_FullFileName = fd.SelectedItems.Item(1)
Result_FileRep = fd.InitialFileName
Result_FileName = Replace(Result_FullFileName, Result_FileRep, "")
Else
' sinon on laisse l ancienne valeur de la cellule
Result_FileName = OldValue
End If
' mise a jour de la valeur de la cellule
Selection.FormulaR1C1 = Result_FileName
End If
End Sub