Afficher un message
Vieux 20/10/2005, 12h29   #1 (permalink)
PascalXLD
Super Moderator
 
Avatar de PascalXLD
 
Date d'inscription: février 2005
Localisation: Rennes
Version Excel : Excel 2000 (PC)
Messages: 8 649
Par défaut Sélectionnner un fichier dans boite de dialogue

Bonjour

J'ai besoin pour une appli de choisir un fichier dans une boite de dialogue pour pouvoir récupérer le chemin et le nom du fichier.
Ensuite je colle tout cela dans une cellule.

Dans le WIKI de MichelXLD (que je remercie encore une fois ici pour son formidable WIKI) il y a une solution pour ouvrir les dossiers avec une méthode
- à partir de Excel 2002 :
Application.fileDialog(msoFileDialogFolderPicker)

- et un lien vers un fil du forum 1ère génération pour version antéreure
LE LIEN

Pour le choix d'un fichier et non d'un dossier il y a une méthode
- à partir de Excel 2002
Application.FileDialog(msoFileDialogFilePicker)

Alors si cela interesse des personnes voici la méthode que j'ai récupérer sur le site de Frédéric Sigonneau (méthode de John Walkenbach) et qui fonctionne sur Excel 2000

************************************************** *******

Option Explicit
'J. Walkenbach
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib 'shell32.dll' _
Alias 'SHGetPathFromIDListA' (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib 'shell32.dll' _
Alias 'SHBrowseForFolderA' (lpBrowseInfo As BROWSEINFO) As Long

Sub test()
MsgBox GetDirectory
End Sub

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

'Définit le Bureau comme dossier racine
bInfo.pidlRoot = 0&

'Invite de la boite de dialogue
If IsMissing(Msg) Then
bInfo.lpszTitle = 'Selectionnez un dossier.'
Else
bInfo.lpszTitle = Msg
End If

'Type de renvoi : dossier
' bInfo.ulFlags = &H1
'Type de renvoi : fichier
bInfo.ulFlags = &H4000


'Affiche la boite de dialogue
x = SHBrowseForFolder(bInfo)

'Traite le résultat
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ''
End If
End Function

************************************************** ****

MichelXLD si tu désires faire le lien vers ce fil dans ton WIKI ou tout recopier vas-y

Bonne journée à tout le monde

Message édité par: Pascal76, à: 20/10/2005 11:47
__________________
Pascal(Visitez mon Blog Photo)

Vous pouvez devenir "Supporter XLD", plus de renseignements ICI
PascalXLD est déconnecté   Réponse avec citation