Discussion :

[Blaiz58]

Bonjour,

Je chercher à bloquer la fonctionnalité " Nom du dossier" quand j'utilise la fonction Application.FileDialog(msoFileDialogFolderPicker). Savez vous s'il existe une possibilité de le faire ?

J'ai cela quand j'utilise cette application :



Et je souhaiterai avoir un truc du genre comme cela ( qu'on ne puisse pas rentrer de nom de dossier manuellement )



Merci pour votre aide

[parmi]

Bonjour,

Tu pourrais créer ton propre navigateur avec un Userform et une Listbox que tu charges en utilisant Dir() en boucle sur le répertoire que tu veux.

[Blaiz58]

Oui mais cela implique de connaitre le répertoire et que la je veux laisser le choix du répertoire qui peut changer selon sur quel poste se trouve le fichier excel.
En fait, j'utilise cela pour pouvoir définir le répertoire d'enregistrement des données du fichier excel mais au format PFS et je peux pas forcer à rajouter ce format si j'utilise la l'application de sauvegarde.

[parmi]

Si tu veux seulement afficher les répertoires pour en sélectionner un, tu peux passer par API.

En entête de module de feuille, tu déclares en Private.
Si en entête de module Standard, déclare en Public

Donc, en entête de code, tu mets ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
 
Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszINSTRUCTIONS As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
 
Private Declare Function SHGetPathFromIDListA Lib "shell32.dll" (ByVal pidl As Long, _
    ByVal pszBuffer As String) As Long
 
Private Declare Function SHBrowseForFolderA Lib "shell32.dll" (lpBrowseInfo As _
    BROWSEINFO) As Long
 
Private Const MAX_PATH = 260
 
 
Function BrowseFolder(Optional ByVal DialogTitle As String) As String
 
    If DialogTitle = vbNullString Then
        DialogTitle = "Select A Folder"
    End If
 
    Dim uBrowseInfo As BROWSEINFO
    Dim szBuffer As String
    Dim lID As Long
    Dim lRet As Long
 
    With uBrowseInfo
        .hOwner = 0
        .pidlRoot = 0
        .pszDisplayName = String$(MAX_PATH, vbNullChar)
        .lpszINSTRUCTIONS = DialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS ' + BIF_USENEWUI
        .lpfn = 0
    End With
    szBuffer = String$(MAX_PATH, vbNullChar)
    lID = SHBrowseForFolderA(uBrowseInfo)
 
    If lID Then
        ''' Retrieve the path string.
        lRet = SHGetPathFromIDListA(lID, szBuffer)
        If lRet Then
            BrowseFolder = Left$(szBuffer, InStr(szBuffer, vbNullChar) - 1)
        End If
    End If
 
End Function

Et tu appelles ainsi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub ChoisirRepertoire()
    Dim Rep As String
 
    Rep = BrowseFolder("Choisir un répertoire")
    MsgBox Rep
End Sub

C'est plus de lignes de code, mais ça fonctionne bien...

[Blaiz58]

J'avoue que c'est pas mal du tout Merci beaucoup !

Et penses-tu qu'il existe une possibilité que je préenregistre un chemin, histoire de ne pas aller à le chercher à tous les coup ?
du style comme ça : .InitialFileName = " "

Mais sinon je t'avoue que c'est du grand art ! Merci beaucoup

[parmi]

Il y a moyen en faisant un "callback".

Autrement, une autre façon plus simple que je viens de trouver qui utilise Shell

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Function BrowseForFolder_Shell(Chemin) As String
    '//Minimum DLL version shell32.dll version 4.71 or later
    '//Minimum operating systems   Windows*2000, Windows NT 4.0 with Internet Explorer*4.0,
    '//Windows*98, Windows 95 with Internet Explorer*4.0
    Dim objShell As Object
    Dim objFolder As Object
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0, Chemin)
 
    If (Not objFolder Is Nothing) Then
        '// NB: If SpecFolder= 0 = Desktop then ....
        On Error Resume Next
        If IsError(objFolder.Items.Item.Path) Then BrowseForFolder_Shell = CStr(objFolder)
        On Error GoTo 0
        '// Is it the Root Dir?...if so change
        If Len(objFolder.Items.Item.Path) > 3 Then
            BrowseForFolder_Shell = objFolder.Items.Item.Path & Application.PathSeparator
        Else
            BrowseForFolder_Shell = objFolder.Items.Item.Path
        End If
    End If
 
    Set objFolder = Nothing
    Set objShell = Nothing
 
End Function
 
Sub ChoisirRepertoire()
    Dim Rep As String, Chemin
    Chemin = "C:\Windows\Temp"
 
    Rep = BrowseForFolder_Shell(Chemin)
    'Vérifier si le chemin est valide ou annulation
    MsgBox Rep
End Sub

Tu peux aller voir le site ici pour divers exemples

Pour ce qui est de conserver le chemin, tu peux utiliser une feuille ou encore la base de registre. Voir GetSetting et SaveSetting.

[Blaiz58]

Merci beaucoup pour ton aide. ça marche impeccable !