Comment ouvrir l'explorateur de fichier en mode "grande icône"

**dede_bo** · 21/10/2020, 10h29

Bonjour à tous,

je vous écris car je suis sur un soucis qui me fait attraper des cheveux blancs.
J'explique: J'essaie (par VBA), d'ouvrir l'explorateur de fichiers dans un répertoire que l'utilisateur à au préalable choisi en mode grande icône.

J'ai cherché un peu partout sur le net, ouvrir l'explorateur de fichiers au répertoire choisi fonctionne à merveille.
Par contre, celui-ci reste dans le mode par défaut. Comme si la propriété est en lecture seul.

Comment faire?
Quelqu'un aurait t'il une idée?

Pour info:
Afin de préserver les droits d'auteurs, le code ci-dessous est ce que j'ai trouvé sur Internet que j'ai dû modifier pour que cela fonctionne.
(Merci au différents auteurs d'avoir écris ce code.)

C'est à dire: L'explorateur de fichier s'ouvre au répertoire sélectionné. Car le code brut trouvé ne fonctionne pas sous Windows 10.

Merci d'avance pour votre aide éventuelle

André

1° la partie déclarative:

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
59
 
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
                (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                ByVal hwnd As Long, _
                ByVal lpOperation As String, _
                ByVal lpFile As String, _
                ByVal lpParameters As String, _
                ByVal lpDirectory As String, _
                ByVal nShowCmd As Long) As Long
 
Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" ( _
                ByVal hWnd1 As Long, _
                ByVal hWnd2 As Long, _
                ByVal lpsz1 As String, _
                ByVal lpsz2 As String) As Long
 
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" ( _
                ByVal hwnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Enum FolderView
    viewDEFAULT = 0
    viewICON = &H7029
    viewLIST = &H702B
    viewREPORT = &H702C
    View = &H702D
    viewTILE = &H702E
End Enum
 
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWTHUMBNAIL As Long = 28717
Private Const WM_COMMAND = &H111
 
' ---------------------------------------------------
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

2° - Les fonctions:

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
 
Private Sub OpenFolder(ByVal pHandle As Long, ByVal sFolderPath As String, Optional ByVal eView As FolderView = viewDEFAULT)
    Dim N As Long, lhWnd As Long, lPrevhWnd As Long
    If Len(Dir(sFolderPath, vbDirectory)) = 0 Then Exit Sub
 
    lPrevhWnd = FindWindow("CabinetWClass", vbNullString)
    ShellExecute pHandle, "Open", sFolderPath, vbNullString, vbNullString, SW_SHOWNORMAL
 
    If eView Then
        Do
            DoEvents: N = N + 1
            lhWnd = FindWindow("CabinetWClass", vbNullString)              ' Choisir cette classe ou l'autre
            ' lhWnd = FindWindow("ExploreWClass", vbNullString)            ' Cela ne change rien
        Loop Until Not (lPrevhWnd = lhWnd Or lhWnd = 0) Or N = 100000
 
        If N = 100000 Or lhWnd = 0 Then Exit Sub
        Call Sleep(100)
 
         lhWnd = FindWindowEx(lhWnd, 0&, "SHELLDLL_DefView", vbNullString)
        SendMessage lhWnd, WM_COMMAND, ByVal eView, 0&
    End If
End Sub
 
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
    Dim window As Long
 
    window = FindWindow(vbNullString, Application.Caption)
 
    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)
 
        ' ShellExecute window, "Open", SelectFolder, vbNullString, vbNullString, SW_SHOWTHUMBNAIL   ' Cette fonction ou l'autre donne
        Call OpenFolder(window, SelectFolder, viewICON)                                             ' le même résultat
    End If   
End Function

3° le code principal:

Code :

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

1
2
3
4
5
6
7
 
    Dim repertoire As String
    Dim window As Long
 
    window = FindWindow(vbNullString, Application.Caption)
 
    repertoire = SelectFolder("Sélectionnez un répertoire :", window)

**MarcelG** · 21/10/2020, 17h21

Bonjour,

Si cela peut t'aider.
Pour ouvrir l'explorateur en plein écran, utiliser l'instruction Shell en précisant le paramètre windowstyle

Code :

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

1
2
3
4
5
Sub ouvrir_chemin()
    Dim chemin As String
    chemin = "chemincompletdurépertoire"
    Shell pathname:="C:\windows\explorer.exe " & chemin, windowstyle:=vbMaximizedFocus
End Sub

**dede_bo** · 21/10/2020, 23h39

Bonsoir,

Merci de votre réponse.
En réalité, cela ne résout pas mon problème réel.

Je vous explique:

Soit 3 répertoires : A, B & C
Ces répertoires contiennent, en réalité des photos.
Les noms des répertoires sont des catégories (fruits, légumes, etc.)

Lorsque vous utilisé le l'explorateur de fichiers et que vous ouvrez le répertoire "A", il affiche le contenu en mode "liste de fichier"
Lorsque vous ouvrez le répertoire "B", les fichiers sont affichés en mode "petites icônes" et le répertoire "C" s'ouvre en mode "grandes icônes.

L'application que j'ai fait permet à l'utilisateur d'avoir un écran avec une sélection d'une catégorie.
Lorsqu'il choisisse une catégorie, il y a un bouton (quand vous cliquez dessus) ouvre l'explorateur de fichier au bon répertoire contenant les photos.
(Cela fonctionne à merveille).

J'aurais aimer (que ce soit pour le répertoire "A", "B" ou "C") que les fichiers soient en mode "grandes icônes".
Mais, hélas, j'ai une liste de fichier pour "A", des petites icônes pour "B" et les grandes icônes pour "C" !

J'aimerais armoniser la situation. Pas du cas par cas !
Comprenez-vous mon problème?

Encore merci de votre aide.
Bien à vous.

André

**jurassic pork** · 22/10/2020, 12h52

hello,
le souci c'est qu'à la fin du code de openfolder :

Code :

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

1
2
         lhWnd = FindWindowEx(lhWnd, 0&, "SHELLDLL_DefView", vbNullString)
        SendMessage lhWnd, WM_COMMAND, ByVal eView, 0&

lhWnd est égal à zéro car la fenêtre n'est pas la fille directe du handle lhWnd passé en paramètre. Il faudrait faire un balayage récursif pour trouver le handle de la fenêtre SHELLDLL_DefView
Mais il y a plus simple :
on peut changer le mode de visualisation par raccourci clavier :

Alt+D, then 3x Tab Jump/ focus Folder Content Pane (required for changing views with Ctrl+Shift+1…8
Ctrl+Shift+1 Change View to Extra Large Icons
Ctrl+Shift+2 Change View to Large Icons
Ctrl+Shift+3 Change View to Medium Icons
Ctrl+Shift+4 Change View to Small Icons
Ctrl+Shift+5 Change View to List View
Ctrl+Shift+6 Change View to Details View
Ctrl+Shift+7 Change View to Tiles View
Ctrl+Shift+8 Change View to Content View
Alt+V, then SF Change View to Size Fit all items within column width

code pour envoyer le raccourci à la fenêtre (à mettre à la place du code VBA au dessus) :

Code :

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

1
2
3
 
        SetForegroundWindow (lhwnd)
        SendKeys ("^+1")

avec :

Code :

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

1
2
3
Private Declare Function SetForegroundWindow _                   
                    Lib "user32" _
                   (ByVal hWnd As Long) As Long

Ami calmant, J.P

**dede_bo** · 22/10/2020, 22h30

Bonjour amis calmant ...

J'ai essayé votre code. Mais, hélas, il ne fonctionne pas.

J'aimerais, au passage vous signaler que vous avez glissé une petite erreur:

Le racourci clavier pour changer le mode de vue n'est pas "Ctrl+Shift+ xxx" (ou xxx est chiffre) mais "Ctrl+Alt+ xxx"

Donc, la ligne de code

Code :

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

1
2
3
4
5
6
 
SendKeys ("^+1")
 
' doit être remplacé par:
 
SendKeys ("^%1")

voir : https://docs.microsoft.com/en-us/off...keys-statement

Autrement:

J'ai ajouté la partie déclarative et
Par contre, J'ai déplacé à différent endroits vos 2 lignes de codes

Je n'ai aucun changement.
Je pense avoir compris ce que vous essayer de faire.
Il faut rendre l'explorateur de fichier "actif" pour que la fonction "SendKeys" fonctionne.
Je pense que le noeud est là.

A quel endroit de la fonction dois-je placer votre code?

Merci de votre aide.

André

**jurassic pork** · 23/10/2020, 00h00

hello,

Envoyé par dede_bo

Bonjour amis calmant ...

J'ai essayé votre code. Mais, hélas, il ne fonctionne pas.

J'aimerais, au passage vous signaler que vous avez glissé une petite erreur:

Le racourci clavier pour changer le mode de vue n'est pas "Ctrl+Shift+ xxx" (ou xxx est chiffre) mais "Ctrl+Alt+ xxx"

Donc, la ligne de code

Code :

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

1
2
3
4
5
6
 
SendKeys ("^+1")
 
' doit être remplacé par:
 
SendKeys ("^%1")

Je confirme que chez moi les raccourcis pour changer le mode d'affichage c'est bien Ctrl Shift et pas Ctrl Alt. C'est que nous n'avons pas certainement le même O.S. Moi je suis en Windows 10. Et je lance la macro à partir d'Excel 2010. Voici les différences de raccourcis entre Windows 7 et Windows 8,10 :

In Windows 8 (And later versions) you can use the following shortcuts for View modes:

CTRL + SHIFT + 1 Extra Large
CTRL + SHIFT + 2 Large Icons
CTRL + SHIFT + 3 Medium Icons
CTRL + SHIFT + 4 Small Icons
CTRL + SHIFT + 5 List
CTRL + SHIFT + 6 Details
CTRL + SHIFT + 7 Tiles
CTRL + SHIFT + 8 Content

In Windows 7 for English exhibition language you can use the the following:

ALT (Left) + V + X = Extra large icons
ALT (Left) + V + R = Large icons
ALT (Left) + V + M = Mediom icons
ALT (Left) + V + N = Small icons
ALT (Left) + V + I = List
ALT (Left) + V + D = Details
ALT (Left) + V + S = Tiles
ALT (Left) + V + T = Content

Voici le code intégral qui fonctionne chez moi (macro TestFindWindow)

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Option Explicit
Private Declare Function SetForegroundWindow _
                     Lib "user32" _
                   (ByVal hWnd As Long) As Long
 
 
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                ByVal hWnd As Long, _
                ByVal lpOperation As String, _
                ByVal lpFile As String, _
                ByVal lpParameters As String, _
                ByVal lpDirectory As String, _
                ByVal nShowCmd As Long) As Long
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
                ByVal hWnd1 As Long, _
                ByVal hWnd2 As Long, _
                ByVal lpsz1 As String, _
                ByVal lpsz2 As String) As Long
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
                ByVal hWnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Enum FolderView
    viewDEFAULT = 0
    viewICON = &H7029
    viewLIST = &H702B
    ViewReport = &H702C
    View = &H702D
    ViewTILE = &H702E
End Enum
 
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWTHUMBNAIL As Long = 28717
Private Const WM_COMMAND = &H111
 
' ---------------------------------------------------
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
 
 
Private Sub OpenFolder(ByVal pHandle As Long, ByVal sFolderPath As String, Optional ByVal eView As FolderView = viewDEFAULT)
    Dim N As Long, lhwnd As Long, lPrevhWnd As Long
    If Len(Dir(sFolderPath, vbDirectory)) = 0 Then Exit Sub
 
    lPrevhWnd = FindWindow("CabinetWClass", vbNullString)
    ShellExecute pHandle, "Open", sFolderPath, vbNullString, vbNullString, SW_SHOWNORMAL
 
    If eView Then
        Do
            DoEvents: N = N + 1
            lhwnd = FindWindow("CabinetWClass", vbNullString)              ' Choisir cette classe ou l'autre
            ' lhWnd = FindWindow("ExploreWClass", vbNullString)            ' Cela ne change rien
        Loop Until Not (lPrevhWnd = lhwnd Or lhwnd = 0) Or N = 100000
 
        If N = 100000 Or lhwnd = 0 Then Exit Sub
        Call Sleep(100)
        SetForegroundWindow (lhwnd)
        SendKeys ("^+1")
'         lhWnd = FindWindowEx(lhWnd, 0&, "SHELLDLL_DefView", vbNullString)
'        SendMessage lhWnd, WM_COMMAND, ByVal eView, 0&
    End If
End Sub
 
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
    Dim window As Long
 
    window = FindWindow(vbNullString, Application.Caption)
 
    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)
 
        ' ShellExecute window, "Open", SelectFolder, vbNullString, vbNullString, SW_SHOWTHUMBNAIL   ' Cette fonction ou l'autre donne
        Call OpenFolder(window, SelectFolder, ViewTILE)                                             ' le même résultat
    End If
End Function
 
 
Sub TestFindWindow()
   Dim repertoire As String
    Dim window As Long
 
    window = FindWindow(vbNullString, Application.Caption)
 
    repertoire = SelectFolder("Sélectionnez un répertoire :", window)
End Sub

et pour bien comprendre d'où vient le problème de recherche de la fenêtre de classe SHELLDLL_DefView voici une capture d'écran de l'espionnage des fenêtres :

Nom : SpyExplorer.PNG
Affichages : 791
Taille : 64,6 Ko

Nom : SpyExplorer.PNG
Affichages : 791
Taille : 64,6 Ko

Il y a toute une arborescence entre la fenêtre de classe CabinetWClass et celle de classe SHELLDLL_DefView

[EDIT] Je viens de faire un essai sous Windows 7 les touches de raccourcis pour un windows en français ne sont pas ALT (Left) + V + Lettre mais ALT(Left)+A+Lettre ( A comme Affichage)
et les lettres ne sont pas les mêmes. Voici une copie d'écran où l'on voit les lettres de raccourcis :
Nom : ExplorerW7.png
Affichages : 770
Taille : 69,6 Ko

Nom : ExplorerW7.png
Affichages : 770
Taille : 69,6 Ko

Par exemple très grandes icônes ALT+A+è . A Noter que le raccourci pour Grandes icônes ne semble pas fonctionner. La lettre est e mais elle est utilisée ailleurs (Actualiser) Bug de Microsoft ?

Ami calmant, J.P

**dede_bo** · 23/10/2020, 08h38

Bonjour,

Wow ! Vous en connaissez énormément !

Je n'arrive pas à la hauteur de vos doigts de pieds sur vos connaissance.
Full respect.

Voici une copie d'écran de mon ordinateur.
Je possède un laptop avec un clavier Belge.

Pièce jointe 582051

J'ai recopié votre code mais sans succès.

Je vous montre que le racourci qui fonctionne est bien "Ctrl" + "Alt" + nombre.

Et voici le résultat (ci-dessous) du résultat.

J'ai l'impression (mon opinion - je me trompe sûrement) que l'application n'est pas sélectionnée lorsqu'on applique le "Send keys".
Cela serait la raison que cela ne fonctionne pas.

Encore merci de bien vouloir donner de votre temps pour m'aider.

Bien à vous
André

**jurassic pork** · 23/10/2020, 10h20

hello,
Quelle est ta version de windows ? Il me semble que sur la vidéo le menu de l'explorateur de fichiers windows est en anglais. Ce n'est pas une version française de windows ?
Ami calmant, J.P

**dede_bo** · 23/10/2020, 13h43

Bonjour,

J'avais mis la copie d'écran (Pièce jointe 582051). Si tu cliques (pas ce message - mais le précédant)
Tu pourras voir ma configuration.

Oui, effectivement, c'est la version Anglais.

Je travaille pour une entreprise étrangère. C'est l'Anglais qui prime.
Donc, pour éviter toute confusion, j'ai installé toutes mes applications en Anglais.

Bien à vous
André

**jurassic pork** · 23/10/2020, 14h47

Envoyé par dede_bo

J'avais mis la copie d'écran (Pièce jointe 582051). Si tu cliques (pas ce message - mais le précédant)
Tu pourras voir ma configuration.

Je ne peux pas lire la pièce jointe. Message d'erreur :

Nom : messageErreur.PNG
Affichages : 752
Taille : 5,5 Ko

Pour le problème faire un point d'arrêt sur la ligne 81 :

Code :

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

 If N = 100000 Or lhwnd = 0 Then Exit Sub

Vérifier la valeur de N et de lhwnd et voir en pas à pas si on passe dans les lignes de code en dessous.

**laurent_ott** · 23/10/2020, 16h35

Bonjour.
Chez moi ça marche avec le code suivant (API en 32 bits) et Ctrl Maj 1 pour les grandes icônes.
Et j'utilise Ctrl L pour atteindre la barre d'adresse et indiquer le répertoire désiré.
L'explorateur Windows doit être ouvert.
Configuration : Windows 10, Excel 2016, (versions françaises).

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
Option Explicit
Option Compare Binary
 
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetWindowA Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
 
Private Const CF_TEXT = 1
Private Const MAXSIZE = 65536
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
 
'------------------------------------------------------------------------------------------------------
Sub Explorateur_Grandes_Icones()
'------------------------------------------------------------------------------------------------------
 
' Trouve le Handle de l'explorateur:
Dim Hdc As LongPtr, i As Integer
Hdc = FindWindowA("CabinetWClass", vbNullString)
 
' Modifie la barre d'adresse pour indiquer le répertoire désiré:
Call Hdc_EnvoyerTouches(Hdc, vbKeyControl, vbKeyL)
Sleep 100
Call Hdc_EnvoyerTouches(Hdc, "C:\Users\ott_l\TPS\") ' <- A adapter pour le répertoire désiré.
Call Hdc_EnvoyerTouches(Hdc, vbKeyReturn)
Sleep 1000
 
' Boucle pour trouver la sélection des fichiers:
For i = 1 To 9
    Call Hdc_EnvoyerTouches(Hdc, vbKeyTab)
    ' Passe en grandes icônes:
    Call Hdc_EnvoyerTouches(Hdc, vbKeyControl, vbKeyShift, vbKey1)
Next i
End Sub
 
 
 
'------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------
Public Sub Hdc_EnvoyerTouches(hWndApp As Variant, ParamArray Combinaison() As Variant)
'------------------------------------------------------------------------------------------------------
' Envoie des touches à une application.
' hWndApp : est soit le numéro Hdc de la fenêtre (ou 0 si fenêtre active), soit son nom.
' Combinaison : touche(s) a envoyer. Ce peut être une chaîne ou une variable vbKey.
'------------------------------------------------------------------------------------------------------
' Exemples : Hdc_EnvoyerTouches Hdc, "Bonjour"
'            Hdc_EnvoyerTouches Hdc, vbKeyMultiply
'------------------------------------------------------------------------------------------------------
' Astuce : l'impression écran est impossible avec Sendkeys, utilisez Hdc_EnvoyerTouches 0, vbKeySnapshot
' ou pour n'avoir que le forumaire actif: Hdc_EnvoyerTouches 0, vbKeyMenu, vbKeySnapshot
' Exmple pour la calculatrice : Hdc_EnvoyerTouches "*Calculatrice*", vbKeyMenu,  vbKeySnapshot
' puis pour coller dans Excel : Sheets("Feuil1").Paste Range("A1")
'------------------------------------------------------------------------------------------------------
Dim i As Integer, j As Integer, s As String, Etat As Boolean, Maj As Boolean
Dim Hdc As Long
 
If IsNumeric(hWndApp) = True Then
    Hdc = hWndApp
Else
    Hdc = TrouverFenetre(CStr(hWndApp))
End If
 
' Vide la presse-papiers:
ClipBoard_Clear
 
' Place le focus sur la fenêtre demandée (si son numéro est passé <> 0):
If Hdc <> 0 Then
    SetForegroundWindow Hdc
    SetFocus Hdc
End If
 
' Si une chaîne de carractères est passée en argument:
If VarType(Combinaison(0)) <> vbInteger Then
    ' L'envoie dans le presse-papiers:
    If ClipBoard_SetData(CStr(Combinaison(0))) = True Then
        ' Si cela réussi alors colle avec Ctrl+V:
        keybd_event vbKeyControl, 0, 0, 0
        keybd_event vbKeyV, 0, 0, 0
        keybd_event vbKeyControl, 0, 2, 0
        keybd_event vbKeyV, 0, 2, 0
    End If
' Si c'est une combinaison numérique qui est passée en argument:
Else
    ' Active:
    For i = LBound(Combinaison()) To UBound(Combinaison())
        keybd_event Combinaison(i), 0, 0, 0
    Next i
    ' Relache:
    For i = LBound(Combinaison()) To UBound(Combinaison())
        keybd_event Combinaison(i), 0, 2, 0
    Next i
End If
Sleep 100
DoEvents
 
End Sub
 
'---------------------------------------------------------------------------------------
Private Function ClipBoard_SetData(MyString As String) As Boolean
'---------------------------------------------------------------------------------------
' Envoie une chaîne de caractères dans le presse-papiers.
' MyString : Chaîne à envoyer
'---------------------------------------------------------------------------------------
' Sources : 32-bit code by Microsoft: http://msdn.microsoft.com/en-us/library/office/ff192913.aspx
'---------------------------------------------------------------------------------------
Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
Dim hClipMemory As LongPtr
 
' Gestion de la taille maximale du message a envoyer au clavier:
If Len(MyString) >= MAXSIZE Then  ' "Chaîne trop grande"
    Exit Function
End If
 
' Gestion des chaînes vides:
If MyString = "" Then Exit Function
 
' Allocate moveable global memory.
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
 
' Lock the block to get a far pointer to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)
 
' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
 
' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then '"Could not unlock memory location. Copy aborted."
   GoTo OutOfHere
End If
 
' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then ' "Could not open the Clipboard. Copy aborted."
   Exit Function
End If
 
' Clear the Clipboard.
EmptyClipboard
 
' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
 
OutOfHere:
If CloseClipboard() <> 0 Then ClipBoard_SetData = True
 
End Function
 
'---------------------------------------------------------------------------------------
Private Function ClipBoard_Clear() As Boolean
'---------------------------------------------------------------------------------------
If OpenClipboard(0) = 0 Then Exit Function
EmptyClipboard
If CloseClipboard() <> 0 Then ClipBoard_Clear = True
End Function
 
'------------------------------------------------------------------------------------------------------
Public Function TrouverFenetre(StrFenetre As String, Optional ByRef StrTitre As String = "") As Long
'------------------------------------------------------------------------------------------------------
' Retourne le Handle de la fenêtre passé en argument. Utilise l'opérateur Like donc accepte * et ?
' et autres, voir l'aide.
' Retourne 0 si la fenêtre n'est pas trouvée.
'------------------------------------------------------------------------------------------------------
Dim Ret As Long
Dim MyStr As String
 
' Boucle sur les fenêtres actives:
Ret = FindWindow(ByVal 0&, ByVal 0&)
Do While Ret <> 0
 
    ' Cherche le nom de la fenêtre:
    MyStr = String(100, Chr$(0))
    GetWindowText Ret, MyStr, Len(MyStr)
 
    ' Si c'est la fenêtre recherchée alors renvoie l'Hdc:
    If Left(MyStr, InStr(1, MyStr, Chr(0)) - 1) Like StrFenetre Then
        TrouverFenetre = Ret
        StrTitre = Left(MyStr, InStr(1, MyStr, Chr(0)) - 1)
        Exit Function
    End If
 
    ' Cherche la fenêtre suivante:
    Ret = GetWindowA(Ret, 2)
 
Loop
 
End Function
'------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------

Cordialement.

**jurassic pork** · 26/10/2020, 12h51

hello,
j'ai trouvé une solution sans utiliser de SendKeys donc normalement indépendante de la langue utilisée dans windows. Il y a une condition pour que cela fonctionne : on ferme (par programmation) toutes les fenêtres de l'explorateur de fichiers qui sont déjà ouvertes avant la sélection et l'affichage du répertoire. Est-ce que cela est gênant ?
Ami calmant, J.P

**MarcelG** · 26/10/2020, 12h56

Hé salut JP!

on ferme (par programmation) toutes les fenêtres de l'explorateur de fichiers qui sont déjà ouvertes avant la sélection et l'affichage du répertoire. Est-ce que cela est gênant ?

Pour mon humble part, dans le cadre de mon développement actuel, absolument pas.

Dans un autre cadre, je ferme une application avant de la réouvrir en "propre".
En l'occurrence, Outlook.

A plus tard, donc, en espérant que cela ne perturbera pas le post de notre ami. .

Bien à toi.

**dede_bo** · 26/10/2020, 14h34

Bonjour à tous,
Suite à ma charge de travail actuel, je n'ai pas eu le temps de regarder.
Je suis désolé.

Je pense que j'aurais plus de temps demain.
Aujourd'hui c'est matériellement pas possible.

A demain.
André

**dede_bo** · 27/10/2020, 09h42

Bonjour à tous,

Désolé pour hier mais j'avais beaucoup de travail.

ATTN jurassic pork:

Voici une copie d'écran de ma configuration au niveau OS et Microsoft Office:

Nom : Specification_Laptop.jpg
Affichages : 758
Taille : 124,3 Ko

Nom : Specification_Laptop.jpg
Affichages : 758
Taille : 124,3 Ko

Ensuite, j'ai ajouté un point d'arrêt à la position demandé
Voici la valeur des 2 variables:

Nom : Debug-VBA.jpg
Affichages : 737
Taille : 189,0 Ko

J'ai testé avec les 2 versions de "SendKeys" ("CTRL + Shift + xxx" et "CTL + Alt + xxx") mais sans succès

ATTN launrent_ott:

J'ai testé votre code. Sans succès également.

Dans votre cas, j'ai filmé ce qui ce passe.

Mais, il y aurait un espoir... Je pense que c'est la séquence des touches qui devraient être mis à jour (mon opinion)

Voilà la situation actuelle.

Je sais que je me répète, (ce n'est pas à 55 ans que l'on change

) mais merci à tous de votre aide.
André

**jurassic pork** · 27/10/2020, 10h05

hello,
si le fait de fermer l'explorateur de fichiers (par programmation) n'est pas gênant voici ma solution.
En pièce jointe un fichier zip comportant un module vba (JpFenModule.bas) à importer dans son classeur ( Visual Basic pour Application Fichier/Importer un fichier).
Dans ce module il y a les fonctions suivantes :

'JPFenModule version 0.1 by Jurassic Pork October 2020
'Les procédures et fonctions présentes dans le module JpFenModule

'1 - Sub FermerFenetres(NomClasse As String)
'Procédure qui ferme toutes les fenêtres ayant pour classe NomClasse

'2 - Sub AttendreFenetre(NomClasse As String, TimeOut As Integer)
'Procédure qui attend que la fenêtre ayant pour classe NomClasse soit visible. On Attend jusqu'à TimeOut secondes.

'3 - Function GetWindowHandle(Parent As Long, ClassName As String, Titre As String, Pid As String) As Long
'Fonction qui retourne le handle de la première fenêtre trouvée ayant les caractéristiques des paramètres transmis.
'Si on on veut pas utiliser un des paramètres on met "*" à la place du paramètre.
'Le paramètre Parent permet d'utiliser un handle de départ pour faire la recherche dans son arborescence.
' Si on met 0 pour le paramètre parent, on cherche parmi toutes les fenêtres.

Et voici comment utiliser ses fonctions dans ton fcode.

1 - La déclaration des codes pour le FolderView n'était pas bonne, voici la version corrigée :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Enum FolderView
ViewDefault = 0
ViewExLgIcon = &H704D
ViewLgIcon = &H704F
ViewMedIcon = &H704E
ViewSmallIcon = &H7050
ViewList = &H7051
ViewDetails = &H704B
ViewTiles = &H704C
ViewContent = &H7052
End Enum

avec ViewExLgIcon pour les icônes extra larges.

voici la nouvelle fonction qui ouvre l'explorateur de fichier avec la vue désirée :

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
Sub OpenExplorerView(ByVal sFolderPath As String, Vue As String)
Dim Pid As Long
Dim hwd As Long
Dim N As Integer
' On ferme tous les explorateurs de fichiers ouverts
FermerFenetres "CabinetWClass"
' On lance un explorateur de fichier
Pid = Shell("explorer.exe " & sFolderPath, vbNormalFocus)
' On attend que la fenêtre de l'explorateur de fichiers soit visible
AttendreFenetre "CabinetWClass", 5
hwd = FindWindow("CabinetWClass", vbNullString)
' On récupère le Handle de la fenêtre Shellview
hwd = GetWindowHandle(hwd, "SHELLDLL_DefView", "ShellView", "*")
' On envoie la commande de changement de vue
If hwd <> 0 Then SendMessage hwd, WM_COMMAND, Vue, 0&
End Sub

et voici comment l'appeler (remplace l'appel à la fonction OpenFolder)

Code :

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

1
2
3
 
'        Call OpenFolder(window, SelectFolder, ViewExLgIcon)
         Call OpenExplorerView(SelectFolder, ViewExLgIcon)

Ami calmant, J.P

**MarcelG** · 27/10/2020, 10h48

Bonjour JP, Bonjour le Forum,

JP,

Je n'arrive pas à ouvrir ton fichier bas (bloqué par Windoxs)
Pourrais-tu en reporter le code.

Merci à toi.

**jurassic pork** · 27/10/2020, 11h19

hello MarcelG,
Voici le code du module :

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
Option Explicit
'JPFenModule version 0.1 by Jurassic Pork   October 2020
'Les procédures et fonctions présentes dans le module JpFenModule
 
 
'1 - Sub FermerFenetres(NomClasse As String)
'Procédure qui ferme toutes les fenêtres ayant pour classe NomClasse
 
 
'2 - Sub AttendreFenetre(NomClasse As String, TimeOut As Integer)
'Procédure qui attend que la fenêtre ayant pour classe NomClasse soit visible. On Attend jusqu'à TimeOut secondes.
 
 
'3 - Function GetWindowHandle(Parent As Long, ClassName As String, Titre As String, Pid As String) As Long
'Fonction qui retourne le handle de la première fenêtre trouvée ayant les caractéristiques des paramètres transmis.
'Si on on veut pas utiliser un des paramètres on met "*" à la place du paramètre.
'Le paramètre Parent permet d'utiliser un handle de départ pour faire la recherche dans son arborescence.
' Si on met 0 pour le paramètre parent, on cherche parmi toutes les fenêtres.
 
 
 
 
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
 
 
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
 
 
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
 
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                ByVal hwnd As Long, _
                ByVal lpOperation As String, _
                ByVal lpFile As String, _
                ByVal lpParameters As String, _
                ByVal lpDirectory As String, _
                ByVal nShowCmd As Long) As Long
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
                ByVal hWnd1 As Long, _
                ByVal hWnd2 As Long, _
                ByVal lpsz1 As String, _
                ByVal lpsz2 As String) As Long
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
                ByVal hwnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
 
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 
 
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
 
 
Private Enum FolderView
ViewDefault = 0
ViewExLgIcon = &H704D
ViewLgIcon = &H704F
ViewMedIcon = &H704E
ViewSmallIcon = &H7050
ViewList = &H7051
ViewDetails = &H704B
ViewTiles = &H704C
ViewContent = &H7052
End Enum
 
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWTHUMBNAIL As Long = 28717
Private Const WM_COMMAND = &H111
Private Const WM_CLOSE = &H10
 
' ---------------------------------------------------
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
 
Private Type Fenetre
    Handle As Long
    Titre As String
    Classe As String
    Pid As String
End Type
 
 
 
 
Private ListFen As Collection
Private ListeFen() As Fenetre
 
 
Public Function GetWindowHandle(Parent As Long, ClassName As String, Titre As String, Pid As String) As Long
    Dim i As Integer
    Dim startD As Date, endD As Date
    ReDim Preserve ListeFen(1 To 1)
    GetWindowHandle = 0
    startD = Timer
    GetWinInfo Parent
    endD = Timer
    Range("F1") = endD - startD
    For i = LBound(ListeFen) To UBound(ListeFen)
    If (ListeFen(i).Classe Like ClassName) And (ListeFen(i).Titre Like Titre) And (ListeFen(i).Pid Like Pid) Then
    GetWindowHandle = ListeFen(i).Handle
    End If
    Next i
    Erase ListeFen
End Function
 
 
Private Sub GetWinInfo(hParent As Long)
     'Sub to recursively obtain window handles, classes and text
     'given a parent window to search
     'Written by Mark Rowlinson
     'www.markrowlinson.co.uk - The Programming Emporium
     'Updated by JP to use Fenetre type
    Dim hwnd As Long, lngRet As Long
    Dim strText As String
    Dim ThreadId As Long
    Dim ThePid As Long
    Dim Fn As Fenetre
    hwnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString)
    While hwnd <> 0
        GetWindowThreadProcessId hwnd, ThePid
        Fn.Pid = CStr(ThePid)
        strText = String$(100, Chr$(0))
        lngRet = GetClassName(hwnd, strText, 100)
        Fn.Classe = Left$(strText, lngRet)
        Fn.Handle = hwnd
        strText = String$(100, Chr$(0))
        lngRet = GetWindowText(hwnd, strText, 100)
        If lngRet > 0 Then
               Fn.Titre = Left$(strText, lngRet)
            Else
               Fn.Titre = "N/A"
        End If
        ListeFen(UBound(ListeFen)) = Fn
        'Range("A" & CStr(UBound(ListeFen))) = Fn.Handle
        'Range("B" & CStr(UBound(ListeFen))) = Fn.Classe
        'Range("C" & CStr(UBound(ListeFen))) = Fn.Titre
        'Range("D" & CStr(UBound(ListeFen))) = Fn.Pid
        ReDim Preserve ListeFen(1 To UBound(ListeFen) + 1)
        GetWinInfo hwnd
         'now get next window
        hwnd = FindWindowEx(hParent, hwnd, vbNullString, vbNullString)
    Wend
End Sub
 
 
Public Sub FermerFenetres(NomClasse As String)
Dim hwd As Long
' On ferme tous les explorateurs de fichiers ouverts
Do While True
    hwd = FindWindow(NomClasse, vbNullString)
    If hwd = 0 Then Exit Do
    SendMessage hwd, WM_CLOSE, 0, 0
Loop
End Sub
 
 
Public Sub AttendreFenetre(NomClasse As String, TimeOut As Integer)
Dim hwd As Long
Dim N As Integer
TimeOut = TimeOut * 4
N = 0
Do
Sleep (250)
hwd = FindWindow(NomClasse, vbNullString)
DoEvents
N = N + 1
Loop Until IsWindowVisible(hwd) = 1 Or N > TimeOut
End Sub

**dede_bo** · 27/10/2020, 15h52

Bonjour

YYYYYEEEAAAAAAAAHHHHH CELA FONCTIONNE ! ....

J'ai dû apporter des modifications dans votre code...

1°) partie déclarative:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Enum FolderView
    ViewDefault = 0
    ViewExLgIcon = &H704D
    ViewLgIcon = &H704F
    ViewMedIcon = &H704E
    ViewSmallIcon = &H7050
    ViewList = &H7051
    ViewDetails = &H704B
    ViewTiles = &H704C
    ViewContent = &H7052
End Enum

J'ai dû retirer le mot "Private" de la ligne "Private Enum FolderView"

2°) Changement du type de variable au second paramètre de la fonction "OpenExplorerView":

Au départ, le type était: "Vue As String"

Code :

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

Sub OpenExplorerView(ByVal sFolderPath As String, Vue As String)

Je l'ai changé en "Vue As FolderView"

Code :

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

Sub OpenExplorerView(ByVal sFolderPath As String, Vue As FolderView)

De cette manière, cela fonctionne très bien.

Vous êtes le "King" !
Grand Merci de votre aide.

Avis au modérateur du forum:
Je pense que toutes les personnes qui m'ont aidé, aimerais peut être encore écrire un dernier commentaire.
Je cloturerai donc ce fil dans 2 jours !

André

**MarcelG** · 27/10/2020, 17h41

Bonsoir JP,

Merci beaucoup.

André,

Content pour toi.

A bientôt.

Comment ouvrir l'explorateur de fichier en mode "grande icône"

VBA

Discussions similaires

Partager

Partager