Choisir un repertoire dans boite openfile

Le
elli6258
Bonjour à tous,
J'ai cherché et je ne trouve rien.. je suis sous excel 2000, et je cherche
une macro qui me permet de selectionner un repertoire.
La macro ci-dessous me permet de récuperer un repertoire mais je suis
obligé de selectonné un fichier pour qu'il me renvoi le chemin.
existe-il une solution à ce problème?
Merci



cheminannuel1 = Application.GetOpenFilename("Tous les fichiers (*.*),*.*", ,
"Choisissez un repertoire de sauvegarde pour le planning ")
cheminannuel = Left(cheminannuel1, Len(cheminannuel1) -
Len(Dir(cheminannuel1)))
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #18293311
Bonjour.
Essaie (pas sûr que ça fonctionne avec XL2000) :

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
MsgBox .SelectedItems(1)
End If
End With

Sinon, mets le code suivant en t^te d'un module :

Option Explicit
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()
Dim Msg As String
Msg = "Choisissez un répertoire."
MsgBox GetDirectory(Msg)
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

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
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

et exécute la macro "Test".

Cordialement.
Daniel


Bonjour à tous,
J'ai cherché et je ne trouve rien.. je suis sous excel 2000, et je cherche
une macro qui me permet de selectionner un repertoire.
La macro ci-dessous me permet de récuperer un repertoire mais je suis obligé
de selectonné un fichier pour qu'il me renvoi le chemin.
existe-il une solution à ce problème?
Merci



cheminannuel1 = Application.GetOpenFilename("Tous les fichiers (*.*),*.*", ,
"Choisissez un repertoire de sauvegarde pour le planning ")
cheminannuel = Left(cheminannuel1, Len(cheminannuel1) -
Len(Dir(cheminannuel1)))


Philippe.R
Le #18293301
Bonjour,
Une série de pistes mais que tu as peut être déjà explorées :
http://frederic.sigonneau.free.fr/Fichiers.htm
--
Avec plaisir
http://dj.joss.free.fr/trombine.htm
http://jacxl.free.fr/mpfe/trombino.html
Philippe.R
Pour se connecter au forum :
http://www.excelabo.net/mpfe/connexion.php
News://news.microsoft.com/microsoft.public.fr.excel
"elli6258" news:%
Bonjour à tous,
J'ai cherché et je ne trouve rien.. je suis sous excel 2000, et je cherche
une macro qui me permet de selectionner un repertoire.
La macro ci-dessous me permet de récuperer un repertoire mais je suis
obligé de selectonné un fichier pour qu'il me renvoi le chemin.
existe-il une solution à ce problème?
Merci



cheminannuel1 = Application.GetOpenFilename("Tous les fichiers (*.*),*.*",
, "Choisissez un repertoire de sauvegarde pour le planning ")
cheminannuel = Left(cheminannuel1, Len(cheminannuel1) -
Len(Dir(cheminannuel1)))



elli6258
Le #18293641
Bonjour Daniel,

effectivement cela ne fonctionne pas sous excel 2000.

J'ai egalement testé le code en dessous en le collant dans un nouveau
module,
les 4 lignes en dessous '32 bits... se mettent en rouge et losque je lance
la macro test j'ai une erreur de compilation avec un message "attendu :nom
de type"
est-ce parce que c'est du 2000?

j'ai un niveau débutant dans vba, j'ai l'impression d'être arrivé dans la
cour des grands avec le code que tu m'as indiqué...

Cordialement
Michel


"Daniel.C"
Bonjour.
Essaie (pas sûr que ça fonctionne avec XL2000) :

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
MsgBox .SelectedItems(1)
End If
End With

Sinon, mets le code suivant en t^te d'un module :

Option Explicit
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()
Dim Msg As String
Msg = "Choisissez un répertoire."
MsgBox GetDirectory(Msg)
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

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
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

et exécute la macro "Test".

Cordialement.
Daniel


Bonjour à tous,
J'ai cherché et je ne trouve rien.. je suis sous excel 2000, et je
cherche une macro qui me permet de selectionner un repertoire.
La macro ci-dessous me permet de récuperer un repertoire mais je suis
obligé de selectonné un fichier pour qu'il me renvoi le chemin.
existe-il une solution à ce problème?
Merci



cheminannuel1 = Application.GetOpenFilename("Tous les fichiers
(*.*),*.*", , "Choisissez un repertoire de sauvegarde pour le planning ")
cheminannuel = Left(cheminannuel1, Len(cheminannuel1) -
Len(Dir(cheminannuel1)))






elli6258
Le #18294591
Super ! merci à tous les deux. cela fonctionne, il y avait un problème dans
le copier coller.
Merci également pour le lien vers F. Sigonneau que je ne connaissais pas.
Bon WK et Bonne Année à tous
Cordialement
Michel



"Philippe.R" %
Bonjour,
Une série de pistes mais que tu as peut être déjà explorées :
http://frederic.sigonneau.free.fr/Fichiers.htm
--
Avec plaisir
http://dj.joss.free.fr/trombine.htm
http://jacxl.free.fr/mpfe/trombino.html
Philippe.R
Pour se connecter au forum :
http://www.excelabo.net/mpfe/connexion.php
News://news.microsoft.com/microsoft.public.fr.excel
"elli6258" news:%
Bonjour à tous,
J'ai cherché et je ne trouve rien.. je suis sous excel 2000, et je
cherche une macro qui me permet de selectionner un repertoire.
La macro ci-dessous me permet de récuperer un repertoire mais je suis
obligé de selectonné un fichier pour qu'il me renvoi le chemin.
existe-il une solution à ce problème?
Merci



cheminannuel1 = Application.GetOpenFilename("Tous les fichiers
(*.*),*.*", , "Choisissez un repertoire de sauvegarde pour le planning ")
cheminannuel = Left(cheminannuel1, Len(cheminannuel1) -
Len(Dir(cheminannuel1)))






Daniel.j
Le #18303211
Bonjour,
cette macro doit fonctionner aussi avec 2000 (?)

Sub SelDossier()
Dim objShell, objFolder, chemin
Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Sélection d'un dossier", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
MsgBox chemin
End Sub

Daniel
FAQ MPFE
http://dj.joss.free.fr/faq.htm

"elli6258"
Bonjour Daniel,

effectivement cela ne fonctionne pas sous excel 2000.

J'ai egalement testé le code en dessous en le collant dans un nouveau
module,
les 4 lignes en dessous '32 bits... se mettent en rouge et losque je lance
la macro test j'ai une erreur de compilation avec un message "attendu :nom
de type"
est-ce parce que c'est du 2000?

j'ai un niveau débutant dans vba, j'ai l'impression d'être arrivé dans la
cour des grands avec le code que tu m'as indiqué...

Cordialement
Michel


"Daniel.C"
Bonjour.
Essaie (pas sûr que ça fonctionne avec XL2000) :

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
MsgBox .SelectedItems(1)
End If
End With

Sinon, mets le code suivant en t^te d'un module :

Option Explicit
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()
Dim Msg As String
Msg = "Choisissez un répertoire."
MsgBox GetDirectory(Msg)
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

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
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

et exécute la macro "Test".

Cordialement.
Daniel


Bonjour à tous,
J'ai cherché et je ne trouve rien.. je suis sous excel 2000, et je
cherche une macro qui me permet de selectionner un repertoire.
La macro ci-dessous me permet de récuperer un repertoire mais je suis
obligé de selectonné un fichier pour qu'il me renvoi le chemin.
existe-il une solution à ce problème?
Merci



cheminannuel1 = Application.GetOpenFilename("Tous les fichiers
(*.*),*.*", , "Choisissez un repertoire de sauvegarde pour le planning
")
cheminannuel = Left(cheminannuel1, Len(cheminannuel1) -
Len(Dir(cheminannuel1)))










Publicité
Poster une réponse
Anonyme