Ouvrir une fenêtre "windows explorer" et définir sa taille et sa position

29ERIC29

XLDnaute Nouveau
Bonjour,

Je cherche à ouvrir 4 fenêtres "windows explorer" en imposant leur taille et position sur l'écran.

J'ai trouvé un code qui fonctionne parfaitement pour ouvrir "notepad.exe" (et positionner les fenêtres en définissant leur taille) et je cherche à l'adapter pour "explorer.exe".
https://www.experts-exchange.com/questions/28323487/MoveWindow-in-VBA-in-EXCEL.html


Je pensais que remplacer :
np_retval = Shell("C:\windows\notepad.exe", vbNormalFocus)
par :
np_retval = Shell("C:\windows\explorer.exe", vbNormalFocus)
suffirait....mais ça n'est pas si simple j'ai l'impression ?


Voici le code si quelqu'un avait une idée pour l'adapter à explorer.exe ?? :

Un grand merci d'avance...et bonne journée

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Option Explicit

Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Const GW_HWNDNEXT As Long = 2
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Sub tile1()
Dim retval As Long, np_retval As Long

np_retval = Shell("C:\windows\notepad.exe", vbNormalFocus)
retval = MoveWindow(GetWinHandle(np_retval), 0, 0, 950, 550, 1) ' Application.hwnd ' X Y largeur hauteur

np_retval = Shell("C:\windows\notepad.exe", vbNormalFocus)
retval = MoveWindow(GetWinHandle(np_retval), 950, 0, 950, 550, 1) ' Application.hwnd ' X Y largeur hauteur

np_retval = Shell("C:\windows\notepad.exe", vbNormalFocus)
retval = MoveWindow(GetWinHandle(np_retval), 950, 550, 950, 550, 1) ' Application.hwnd ' X Y largeur hauteur

np_retval = Shell("C:\windows\notepad.exe", vbNormalFocus)
retval = MoveWindow(GetWinHandle(np_retval), 0, 550, 950, 550, 1) ' Application.hwnd ' X Y largeur hauteur

End Sub

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Function ProcIDFromWnd(ByVal hwnd As Long) As Long
Dim idProc As Long

' Get PID for this HWnd
GetWindowThreadProcessId hwnd, idProc
ProcIDFromWnd = idProc

End Function

Function GetWinHandle(hInstance As Long) As Long
Dim tempHwnd As Long

' Grab the first window handle that Windows finds:
tempHwnd = FindWindow(vbNullString, vbNullString)

' Loop until you find a match or there are no more window handles:
Do Until tempHwnd = 0
' Check if no parent for this window
If GetParent(tempHwnd) = 0 Then
' Check for PID match
If hInstance = ProcIDFromWnd(tempHwnd) Then
' Return found handle
GetWinHandle = tempHwnd
' Exit search loop
Exit Do
End If
End If

' Get the next window handle
tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT)
Loop
End Function
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 

Modeste geedee

XLDnaute Barbatruc
Bonsour®
;-)
pour information la source réelle est :
https://groups.google.com/forum/#!topic/microsoft.public.fr.excel/x9GMyquDxsE
il s'agit du groupe de news "MPFE" (anciennement hébergé sur les serveurs Microsoft de Seattle) et qui survit depuis sont abandon par Microsoft
grace à la volonté de quelques réfractaires… dont je fis partie (ainsi que Denis Michon(MichD), Misange, Victor21, Paritec, Jacky67, etc...)

La base de news "flottante" se maintient par la maj de plusieurs réplicateurs
dont Google et Aioe.org
:-(( mais aussi Génération-nt qui n'a d'ailleurs jamais signalé son appropriation trompeuse et abusive
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonsoir je passait par la et je n'ai pas pu m'en empêcher
pour être honnête de mon point de vue ,ca fait un peu to much pour 4 fenêtres explorer
j'ai visité aussi le lien que donne modeste geedee et vous avez le même problème
1 vous ne savez pas ou aller chercher les données dont vous avez besoins
2 ce la provoque une palanqué d'usine a gaz avec les api affreuse que même moi j’irais pas deboguer
j'ai cru comprendre sur l'autre site aussi un problème de gestion d'attente la encore ou aller chercher les données

il n'y a pas de soucis je vais vous le dire
en premier lieu vous prenez le tread retval pour en aller dégoter le handle de la fenêtre correspondant au tread
déjà ca c'est une torture des que l'on touche a l'api treadprocc
vous n'en avez pas besoins dans l'exemple qui va suivre dans tout les cas on aura besoins seulement de (findwindow et movewindow)
parlons de la gestion d'attente que certain serait tenter et le font d’ailleurs d'utiliser un sleep voir un wait et tout autre timer de leur cru

comment peux ton faire sans l'usine a gaz des apis
commencons
on va commencer par creer deux array les dossiers et les positions
les voila
Code:
mesdossiers = Array("C:\Users\polux\Desktop\imageBouton", "C:\Users\polux\Desktop\lien streaming", "C:\Users\polux\Desktop\cature d'ecran api vba", "C:\Users\polux\Desktop\wisiwig fonctionnels")
    mespositions = Array("0, 0, 950, 550, 1", "950, 0, 950, 550, 1", "950, 550, 950, 550, 1", "0, 550, 950, 550, 1")
jusque la c'est pas compliqué

nous allons créer en latebinding un object"shell.application"
le voila
Code:
Set objShell = CreateObject("shell.application")

ensuite nous allons ouvrir une boucle ,vous l'avez compris pour boucler sur l'array
dans cette boucle en premier lieu on va demander le nombre de fenetre affichée sur le bureau et le memoriser
ensuite on va ouvrir l'explorateur avec shell celui la je l'ai pas mis en late binding donc référence scripting.runtime requise et doit être activée
une fois l'explorer lancer sur un des dossier de l'array
il nous faut une gestion d'attente que windows finisse le boulot d'afficher la fenetre et ca c'est la premiere lacune qu'il vous manquait
et bien c'est tout simple l'object créé en tout début possède une constant windows qui elle même posede une propriété ".count"
et oui voila ce qu'il vous manque pour faire sauter les sleep et wait une seconde et compagnie
il nous reste plus que avec les api movewindow et findwindow placer nos fenêtres
oui mais la vous alliez chercher loin pour le handle car vous ne saviez pas comment avoir le nom de la fenêtre et bien la encore l'object du debut possede donc une constante windows et forcement ".name"
resultat je remplace tout votre code par 10 lignes de code
j'ai mis en gras ce qui vous manquait et qui vous poussait a monter une usine a gaz avec les apis
Code:
Sub test2()
    mesdossiers = Array("C:\Users\polux\Desktop\imageBouton", "C:\Users\polux\Desktop\lien streaming", "C:\Users\polux\Desktop\cature d'ecran api vba", "C:\Users\polux\Desktop\wisiwig fonctionnels")
    mespositions = Array("0, 0, 950, 550, 1", "950, 0, 950, 550, 1", "950, 550, 950, 550, 1", "0, 550, 950, 550, 1")
    Set objShell = CreateObject("shell.application")
    For x = 0 To UBound(mesdossiers)
        nbfenetre = CLng(objShell.Windows.Count)
        retval = Shell("C:\windows\System32\explorer.exe " & Chr(32) & mesdossiers(x) & Chr(32), vbNormalFocus)
        Do: DoEvents: Loop While objShell.Windows.Count = nbfenetre: pos = Split(mespositions(x), ",")
        MoveWindow FindWindow(vbNullString, objShell.Windows(nbfenetre - 1).locationname), pos(0), pos(1), pos(2), pos(3), pos(4)
    Next
End Sub

mille excuse pour le déterrage du sujet je n'ai pas pu m'en empêcher je haï les usines a gaz avec les apis sauf si c'est nécessaire
ca rafraîchi la page du module d'un coup la j'y vois plus clair ;)

allez je donne les déclarations des apis 32/64 bits au cas ou quand même
Code:
#If VBA7 Then
    Declare Function ptrsafe MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Declare Function ptrsafe FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
    Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
pour le 64 bits il faudra cerifier les long/lonptr comme je suis en 32 bit je ne peut pas contrôler
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 036
Messages
2 084 812
Membres
102 676
dernier inscrit
LN6