XL 2010 VBA - Insérer le nom d'un fichier dans une cellule spécifique

[tchi456]

Bonjour,

Je souhaiterais par simple clic (ou éventuellement par double clics mais sans devoir créer un bouton) dans certaines cellules pouvoir ouvrir un explorateur de fichier et insérer dans ces cellules le nom des fichiers sélectionnés (nom du fichier sans l'extension).

Exemple:
Si je clique ou double clics dans la cellule B5, j'aimerais que ça ouvre un explorateur de fichiers et lorsque je sélectionne un fichier quelconque, le nom de ce fichier apparaisse dans ma cellule B5.

Pouvez-vous m'aider?

Mes meilleures salutations,

Thierry

 

[Robert]

Bonjour Tchi, bonjour le forum,

En pièce jointe ton fichier modifié avec la macro événementielle BeforeRightClick qui réagit non pas au clic comme tu l'as demandé mais au clic du bouton droit.
J'ai codé deux options :
1. le nom complet avec chemin d'accès
2. seulement le nom du fichier.
Supprime la ligne inutile...
Le code :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim EF As FileDialog 'déclare la variable EF (Explorateur de Fichiers)

If Application.Intersect(Target, Range("B5:B19")) Is Nothing Then Exit Sub 'si la selection a lieu ailleurs que dans la plage B5:B19, sort de la procedure
If Target.Cells.Count > 1 Then Exit Sub 'si plus d'une seule cellule selectionnée dans la plage, sort de la procédure
Cancel = True 'annule le menu contextuel lié au double-clic
Set EF = Application.FileDialog(msoFileDialogOpen) 'définit l'exporateur de fichier EF
EF.AllowMultiSelect = False 'n'autorise la sélection que d'un seul fichier
EF.Show 'affiche EF
If EF.SelectedItems.Count > 0 Then 'condition : si au moins un fichuier a été sélectionné
    'supprime un des deux ligne en dessous en fonction de tes besoins
    Target.Value = EF.SelectedItems(1) 'affiche le nom complet avec chemin d'accès dans la cellule
    Target.Value = Split(EF.SelectedItems(1), "\")(UBound(Split(EF.SelectedItems(1), "\"))) 'n'affiche que le nom du fichier dans la cellule
    '****************************************************************
End If 'fin de la condition
End Sub

Le fichier :

 

[tchi456]

Bonjour Robert,

Merci pour votre proposition qui fonctionne parfaitement bien. Je souhaite cependant le faire par double clics.
C'est intéressant de pouvoir garder le chemin d'accès mais est-il possible qu'il s'affiche dans une autre colonne ?

Exemple:
Si je clic en B5 le nom s'affiche (sans l'extension du fichier) en B5 et le chemin en G5.

Mes meilleures salutations,

Thierry

 

[job75]

Bonjour tchi456, Robert,

Avec un seul clic et GetOpenFilename :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(ActiveCell, [B5:B19]) Is Nothing Then Exit Sub
Dim x$, p%, pp%
x = Application.GetOpenFilename
p = InStrRev(x, ".")
pp = InStrRev(x, Application.PathSeparator)
Union(ActiveCell, ActiveCell(1, 6)) = ""
If p Then ActiveCell = Mid(x, pp + 1, p - pp - 1): ActiveCell(1, 6) = x
[A1].Select
End Sub

A+

 

[tchi456]

Bonjour Job75,

Votre code fonctionne nickel; c'est exactement ce que je recherchais.

Un grand MERCI à vous deux pour votre aide.

Meilleures salutations et bonne journée,

Thierry