Sélectionner un répertoire avec une boite de dialogue en VBA
lmarc95
-
6 août 2001 à 17:38
choupi64 Messages postés 21 Date d'inscription mardi 20 janvier 2004 Statut Membre Dernière intervention 2 septembre 2005 - 5 sept. 2005 à 11:46
choupi64 Messages postés 21 Date d'inscription mardi 20 janvier 2004 Statut Membre Dernière intervention 2 septembre 2005 - 5 sept. 2005 à 11:46
A voir également:
- Shgetpathfromidlist
- Selectionner la derniere cellule non vide d'une colonne excel vba ✓ - Forum Visual Basic 6
- Selection derniere cellule non vide plage cellule Excel - Forum Visual Basic 6
- Derniere cellule remplie d'une colonne - Forum Visual Basic 6
- Doevents vba - Conseils pratiques -Visual Basic / VB.NET
- Vba dernière cellule non vide (Ignorer les formules résultat "") - Forum VBA Office (Excel, Word ...)
5 réponses
Voici un bout de code qui devrait répondre à tes pbs: affiche un dialogue de rech de rep et renvoi une chaine content ce rep
Private Type BROWSEINFO ' used by the function GetFolderName
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
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer bInfo.pidlRoot 0& ' Root folder Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Selectionner un répertoire de travail" ' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
x = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function
Private Sub CommandButton2_Click()
Dim Rep0 As String
Rep0 = GetFolderName("Choisissez un répertoire de travail")
If Rep0 = "" Then Exit Sub
FrmE2S.TextBox1.Text = Rep0
End Sub
Private Type BROWSEINFO ' used by the function GetFolderName
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
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer bInfo.pidlRoot 0& ' Root folder Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Selectionner un répertoire de travail" ' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
x = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function
Private Sub CommandButton2_Click()
Dim Rep0 As String
Rep0 = GetFolderName("Choisissez un répertoire de travail")
If Rep0 = "" Then Exit Sub
FrmE2S.TextBox1.Text = Rep0
End Sub
