Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre du Club
    Comment ouvrir l'explorateur de fichier en mode "grande icône"
    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é

    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


    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)

  2. #2
    Expert éminent
    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

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


  3. #3
    Membre du Club
    réaction
    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é

  4. #4
    Expert confirmé
    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
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  5. #5
    Membre du Club
    Mauvaise nouvelle ... Cela ne fonctionne pas
    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/office/vba/language/reference/user-interface-help/sendkeys-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é

  6. #6
    Expert confirmé
    hello,
    Citation Envoyé par dede_bo Voir le message
    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 :



    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 :


    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
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  7. #7
    Membre du Club
    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.



    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é

  8. #8
    Expert confirmé
    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
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  9. #9
    Membre du Club
    Réponse
    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é

  10. #10
    Expert confirmé
    Citation Envoyé par dede_bo Voir le message

    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 :



    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.
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  11. #11
    Rédacteur

    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.
    Débutants, n'hésitez pas à consulter mon mémento sur la programmation en VBA pour EXCEL tome 1.
    Ou le tome 2 qui aborde la programmation en mode graphique avec un exemple de programmation d'un jeu d'arcade en VBA
    Pour les curieux, le tome 3 qui aborde le problème du voyageur de commerce.
    Le tome 4 est consacré à la cryptologie en VBA
    Vous découvrirez dans le tome 5 les fonctions SQL pour gérer les tableaux de données et l'application Sentinelle qui veille sur vos fichiers.
    Le tome 6, dernier de la série, vous apprendra à créer des fonctions pour simplifier la vie des utilisateurs.
    Le Crible Quadratique donne toutes les fonctions pour les opérations sur les grands nombres en VBA.
    En bonus : Programmation en VBA de menus personnalisés pour Excel.
    N'oubliez pas de consulter les FAQ EXCEL et les cours et tutoriels.

  12. #12
    Expert confirmé
    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
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  13. #13
    Expert éminent
    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.

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


  14. #14
    Membre du Club
    Réaction
    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é

  15. #15
    Membre du Club
    Test et mauvaise nouvelle
    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:



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



    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é

  16. #16
    Expert confirmé
    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
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  17. #17
    Expert éminent
    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.

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


  18. #18
    Expert confirmé
    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
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  19. #19
    Membre du Club
    YYYYYEEEAAAAAAAAHHHHH CELA FONCTIONNE ! ....
    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é

  20. #20
    Expert éminent
    Bonsoir JP,

    Merci beaucoup.

    André,

    Content pour toi.

    A bientôt.

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


###raw>template_hook.ano_emploi###