Sélection d'un répertoire par boite de dialogue

  • Initiateur de la discussion Initiateur de la discussion olic95
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

O

olic95

Guest
Bonjour à tous,

Existe-t'il une boite de dialogue prédéfinie permettant de sélectionner un répertoire pour par exemple effectuer une sauvegarde à la sortie d'une macro ?

Merci.

Olivier.
 
Re : Sélection d'un répertoire par boite de dialogue

Bonjour

Ce petit code permet ce que tu souhaites:

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

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

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Range("A1") = GetDirectory
Else
GetDirectory = ""
End If
End Function

Sub appel()
On Error Resume Next
Range("A1").ClearContents
Msg = "Selection de la directory désirée"
ChDir GetDirectory(Msg)
Var = [A1]
End Sub
 
Re : Sélection d'un répertoire par boite de dialogue

Ouah.... j'comprends rien ! Mais si ça marche, je pense que je ne vais pas chercher plus loin ;o§

Merci lapix.

J'imagine que si tu me proposes ça, c'est qu'il n'existe aucune boite prédéfinie du genre de celle qui apparaît quand on fait "Fichier / Enregistrer sous" dans EXCEL !?
 
Re : Sélection d'un répertoire par boite de dialogue

c'est la meme chose sauf sauf que ce que tu dis t'oblige a selectionner un fichier. Pas ce que je t'ai joint.

mets juste : variable=getdirectory(msg) et tu recuperes le repertoire dans variable

(msg = titre de la boite de dialogue)
 
Re : Sélection d'un répertoire par boite de dialogue

Bonjour à Toutes et à tous,

Ci dessous une procédure un peu plus simple et qui marche aussi.

Code:
 Function ChoisirDossier()
Dim ObjShell, objFolder, SecuriteSlash As Byte

Set ObjShell = CreateObject("Shell.Application")
Set objFolder = ObjShell.BrowseForFolder(&H0&, "Choisissez un répertoire", &H1&)

If objFolder Is Nothing Then GoTo EndProc

If Left(objFolder.self.Path, 2) = "::" Then GoTo EndProc
ChoisirDossier = objFolder.self.Path
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then ChoisirDossier = Left(ChoisirDossier, Len(ChoisirDossier) - 1)

EndProc:

Set objFolder = Nothing
Set ObjShell = Nothing
End Function

A+

Creepy
 
Re : Sélection d'un répertoire par boite de dialogue

Bonjour Lapix, Creepy, le forum,

Effectivement Creepy, ta solution est un peu plus "simple" !

Je vais garder cette dernière, tester et vous tenir au courant.

Merci.

Olivier.
 
Re : Sélection d'un répertoire par boite de dialogue

Salut à tous,

Creepy, ta solution est géniale, elle fonctionne bien et elle est surtout un peu plus simple que celle de lapix. Donc elle est adoptée.

Merci à vous tous pour vos réponses.

A bientôt.

Olivier.
 
Re : Sélection d'un répertoire par boite de dialogue

bonjour,


je rebondis :
je souhaite utiliser ce code.
en ajoutant un dernier paramètre REP à ObjShell.BrowseForFolder, il est possible d'afficher par défaut l'aboresence avec REP comme niveau supérieur.
exemple :
ObjShell.BrowseForFolder(&H0&, "Choisissez un répertoire", &H1&, REP)

Je cherche à afficher REP - ce qui est facile - puis éventuellement à pouvoire REMONTER dans l'arboresence proposée par défaut ? ce qui me l'est moins !!!

avez vous des idées ?
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
37
Affichages
1 K
Réponses
5
Affichages
551
Retour