Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Choisir un repertoire dans boite openfile

5 réponses
Avatar
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)))

5 réponses

Avatar
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)))


Avatar
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" a écrit dans le message de
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)))



Avatar
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" a écrit dans le message de news:

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)))






Avatar
elli6258
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" <AS_rauphil_chez_wanadoo.fr> a écrit dans le message de news:
%
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" a écrit dans le message de
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)))






Avatar
Daniel.j
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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)))