[VBA] Une boîte de dialogue pour choisir un dossier sur le DD ?
Q&R publiée par MyDearFriend! le 14-08-2008 (14081 Lectures)
Si vous avez besoin d'afficher une boîte de dialogue invitant l'utilisateur à pointer un dossier du disque dur, voici deux fonctions personnalisées intéressantes :
1ère façon de faire :
2ème façon de faire :
1ère façon de faire :
Sub Test1()
Dim Chemin$
Chemin = SelectDossier
If Chemin <> "" Then MsgBox "Vous avez sélectionné :" & vbCrLf & Chemin
End Sub
Function SelectDossier$(Optional Titre$ = "Choisissez le dossier et cliquez sur le bouton ""Choix Dossier""")
'myDearFriend! - www.mdf-xlpages.com
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Choix Dossier"
.InitialFileName = ThisWorkbook.Path & "\"
.Title = Titre
.Show
If .SelectedItems.Count > 0 Then
SelectDossier = .SelectedItems(1)
End If
End With
End Function
2ème façon de faire :
Sub Test2()
Dim Chemin$
Chemin = SelectDossier
If Chemin <> "" Then MsgBox "Vous avez sélectionné :" & vbCrLf & Chemin
End Sub
Function SelectDossier$(Optional Titre$ = "Sélectionnez dans l'arborescence :")
'myDearFriend! - www.mdf-xlpages.com
Dim Dossier As Object
Dim Chemin$
'Arborescence "Poste de travail"
Set Dossier = CreateObject("Shell.Application").BrowseForFolder(0, Titre, 513, _
"::{20D04FE0-3AEA-1069-A2D8-08002B30309D}")
If Dossier Is Nothing Then Exit Function
On Error Resume Next
Chemin = Dossier.Items.Item.Path
Chemin = Chemin & IIf(Right(Chemin, 1) <> "\", "\", "")
On Error GoTo 0
If Left(Chemin, 1) = ":" Then Chemin = "" 'Le "Poste de travail" n'est pas un répertoire valable
SelectDossier = Chemin
End Function
|