Discussion :

[soubichat]

Bonjour,
Dans une application que j'ai créée, j'ai disposé des boutons pour sélectionner des chemins de répertoire. Le problème c'est que ça bloque avec les changements vba dus au 64 bits. J'ai bien lu l'aide du site mais je ne comprends pas du tout comment reconnaître les variables long à modifier et celles qu'il faut conserver. Et comme je n'ai pas d'ordinateur 64 bits, je ne pas tester si ce que je fais fonctionne.

J'aimerais que le code ci-dessous fonctionne en s'adaptant à la version (64 bits ou 32 bits) de l'utilisateur. Qui peut m'aider ?
Et qui accepterait de tester le résultat final en 64 bits ?

Voilà le code :

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
Option Explicit
 
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
 
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
    ByVal lpString2 As String) As Long
 
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
     ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
 
Public Function SelectFolder(Titre As String, Handle As Long) As String
    Dim lpIDList As Long
    Dim strBuffer As String
    Dim strTitre As String
    Dim tBrowseInfo As BrowseInfo
 
    strTitre = Titre
    With tBrowseInfo
        .hWndOwner = Handle
        .lpszTitle = lstrcat(strTitre, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
 
    lpIDList = SHBrowseForFolder(tBrowseInfo)
 
    If (lpIDList) Then
        strBuffer = String(260, vbNullChar)
        SHGetPathFromIDList lpIDList, strBuffer
        SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    End If
End Function

Le fichier joint contient uniquement un bouton et le code ci-dessus
sélectionner un répertoire.xls

[kiki29]

Salut,tu liras (ou reliras) avec interêt http://arkham46.developpez.com/artic...ice/vba64bits/

[soubichat]

Oui, j'ai déjà lu l'article mais je ne comprends pas ce qu'est un pointeur et Excel 2003 n'a pas supporté les ajouts de codes conformes à ce qui était marqué dans l'article donc je demande de l'aide.

[kiki29]

Re, voir sur http://dico.developpez.com/html/1762...s-pointeur.php

[soubichat]

Je pense avoir compris comment faire la bascule entre 64 bits et 32 bits.
Pour l'adapation véritable au 64 bits on verra plus tard parce que pour l'instant, ça ne passionne pas vraiment les foules.

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
 
Option Explicit
#If Win64 = False Then
        Private Const BIF_RETURNONLYFSDIRS = 1
        Private Const BIF_DONTGOBELOWDOMAIN = 2
 
        Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
        Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
            ByVal lpBuffer As String) As Long
        Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
            ByVal lpString2 As String) As Long
 
        Private Type BrowseInfo
            hWndOwner As Long
            pIDLRoot As Long
            pszDisplayName As Long
            lpszTitle As Long
             ulFlags As Long
            lpfnCallback As Long
            lParam As Long
            iImage As Long
        End Type
 
        Public Function SelectFolder(Titre As String, Handle As Long) As String
            Dim lpIDList As Long
            Dim strBuffer As String
            Dim strTitre As String
            Dim tBrowseInfo As BrowseInfo
 
            strTitre = Titre
            With tBrowseInfo
                .hWndOwner = Handle
                .lpszTitle = lstrcat(strTitre, "")
                .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
            End With
 
            lpIDList = SHBrowseForFolder(tBrowseInfo)
 
            If (lpIDList) Then
                strBuffer = String(260, vbNullChar)
                SHGetPathFromIDList lpIDList, strBuffer
                SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
            End If
        End Function
#End If

et pour le bouton :

Code :

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

1
2
3
4
5
6
7
Private Sub CommandButton3_Click()
    #If Win64 = False Then
        Range("B2") = SelectFolder("Choisir un répertoire", 0)
    #Else
        MsgBox "Ce bouton ne fonctionne pas dans Excel 64 bits."
    #End If
End Sub

[patricktoulon]

bonjour

ci c'est pour selectionner un dossier (folder) tu a (xldialogfolderpicker) integré dans l'application depuis 2002 si je me trompe pas


au plaisir