XL 2016 VBA - Alternative à AddressOf dans un module de classe / UserForm

[Dudu2]

Bonjour,
Quelqu'un a-t-il déjà tenté ce challenge ?
Merci

 

[patricktoulon]

les api déclarée en 64 tu me diras si c'est bon ou pas

Option Explicit


Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type

Private Type MONITORINFO: cbSize As Long: rcMonitor As RECT: rcWork As RECT: dwFlags As Long: End Type

Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFO) As Long

Private Declare PtrSafe Function MonitorFromPoint Lib "user32.dll" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As LongPtr) As LongPtr

Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal dwFlags As Long) As LongPtr
Sub test()
'coté:=0    =l'ecran gauche si 2 ecran ou ecran si un seul ecran
'coté:=1    =l'ecran  droite si 2 ecran ou ecran si un seul ecran
'coté:=2    ='lécran ou se trouve la fenêtre excel
'coté omis  =gauche par defaut ou ecran  si un seul ecran
afficheUserform UserForm1, coté:=2
End Sub
Sub afficheUserform(usf, Optional coté As Long = 0)   'centre ecran gauche ou centre de l'ecran par defaut si un seul ecran
    Dim MI_G As MONITORINFO, Mx, My, MG, MExcel, gauche#, LtoP, fois&, PtPx#
   
    Mx = MonitorFromPoint(100, 100, &H2)    '&H2=MONITOR_DEFAULTTONEAREST 'l'ecran a 100 de droite du point (0,0)
   
    My = MonitorFromPoint(-100, -100, &H2)    '&H2=MONITOR_DEFAULTTONEAREST'l'ecran a -100 de gauche du point (0,0)
   
    MExcel = MonitorFromWindow(Application.hWnd, &H1) ' l'ecran ou se trouve l'application excel
   
     MG = Mx: fois = 1
   
    If Val(My) <> Val(Mx) Then MG = My: fois = -1
   
    If coté = 1 Then fois = Abs(fois)
   
    If coté = 2 Then MG = MExcel: fois = 1
   
    PtPx = 0.75    ' que saint DUDU me pardonne j'en ai ras le bol de ce ptpx :):):)
   
    MI_G.cbSize = Len(MI_G): GetMonitorInfo MG, MI_G

   
    gauche = (((MI_G.rcMonitor.Right * 0.75) - (UserForm1.Width)) / 2) * fois
   
    LtoP = (((MI_G.rcMonitor.Bottom * 0.75) - (UserForm1.Height)) / 2) * fois
   
    With usf
        .Show 0
        .Move gauche, LtoP
    End With
End Sub

 

[Dudu2]

Oui ok, afficher à gauche, très bien. Tes calculs de position sont-ils corrects ?

Alors merci d'avoir posté ce test car cela m'a incité à proposer aussi un code et à le tester sur 2 moniteurs puisque j'ai maintenant mon Swith HDMI qui facilite grandement la manip.

Et là, grâce aux tests, j'ai découvert un truc que je n'avais pas prévu: le rcMonitor.Top peut être non nul (positif ou négatif) !
Donc, contrairement à ce que j'ai écrit précédemment, voici la position d'un UserForm sur un moniteur:

With MonitorInformation
    UserForm1.StartUpPosition = 0
    UserForm1.Left = .rcMonitor.Left * PxToPt + ((.rcMonitor.Right - .rcMonitor.Left) * PxToPt - UserForm1.Width) / 2
    UserForm1.Top = .rcMonitor.Top * PxToPt + ((.rcMonitor.Bottom - .rcMonitor.Top) * PxToPt - UserForm1.Height) / 2
End With

 

[Dudu2]

Et donc le petit code testé qui permet de placer le UserForm à gauche, au milieu (si plus de 2 moniteurs) ou à droite. A noter que j'ai raccourci le code de la recherche de tous les moniteurs.

Option Explicit

Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type
Private Type MONITORINFO: cbSize As Long: rcMonitor As RECT: rcWork As RECT: dwFlags As Long: End Type
Private Declare PtrSafe Function MonitorFromPoint Lib "user32.dll" (ByVal X As Long, ByVal Y As Long, ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef MI As MONITORINFO) As Long
Private Const MONITOR_DEFAULTTONULL As Long = 0
Private Const MONITOR_DEFAULTTONEAREST As Long = 2

'--------------------
'Le UserForm baladeur
'--------------------
Sub TestUserForm()
    Dim TabMIs() As MONITORINFO
    Dim i As Integer
    '
    Const PxToPt = 0.6
    'Const PxToPt = 0.75
    Const Moniteur = "Gauche"
    'Const Moniteur = "Milieu"
    'Const Moniteur = "Droit"
 
    TabMIs = GetAllMonitorInfo
 
    Select Case Moniteur
        Case "Gauche"
            i = 1
        Case "Milieu"
            i = Int((UBound(TabMIs) + 1) / 2)
        Case "Droit"
            i = UBound(TabMIs)
    End Select
 
    With TabMIs(i)
        UserForm1.StartUpPosition = 0
        UserForm1.Left = .rcMonitor.Left * PxToPt + ((.rcMonitor.Right - .rcMonitor.Left) * PxToPt - UserForm1.Width) / 2
        UserForm1.Top = .rcMonitor.Top * PxToPt + ((.rcMonitor.Bottom - .rcMonitor.Top) * PxToPt - UserForm1.Height) / 2
        'UserForm1.Label1.Caption = "Moniteur " & Moniteur
        UserForm1.Show vbModeless
    End With
End Sub

'---------------------------
'Get all Monitor Information
'---------------------------
Function GetAllMonitorInfo() As MONITORINFO()
    Dim MI As MONITORINFO
    Dim TabMIs() As MONITORINFO
    Dim NbMIs As Integer
    Dim X As Long
    Dim Y As Long
    Dim hMonitor As LongPtr
    Dim PreviousLeft As Long
 
    'Look for monitors on the right of the primary monitor
    X = -10 ^ 6
    Y = 1
    PreviousLeft = -1
 
    Do While 1
        hMonitor = MonitorFromPoint(X, Y, MONITOR_DEFAULTTONEAREST)
        MI.cbSize = Len(MI)
        Call GetMonitorInfo(hMonitor, MI)
        With MI.rcMonitor
            If .Left = PreviousLeft Then Exit Do
            NbMIs = NbMIs + 1
            ReDim Preserve TabMIs(1 To NbMIs)
            TabMIs(NbMIs) = MI
            PreviousLeft = .Left
            X = .Left + .Right
        End With
    Loop
 
    'Return value
    GetAllMonitorInfo = TabMIs
End Function

 

[Dudu2]

Illustration...

 

[Dudu2]

Je veux te signaler aussi qu'en 64 bits, la fonction déclarée comme suit:

Private Declare PtrSafe Function MonitorFromPoint Lib "user32.dll" (ByVal X As Long, ByVal Y As Long, ByVal dwFlags As Long) As LongPtr

ne fonctionne pas pour une valeur de dwFlags = MONITOR_DEFAULTTONULL.
On a déjà du bol que ça fonctionne avec dwFlags = MONITOR_DEFAULTTONEAREST.
Il semble que l'argument dwFlags ne soit pas vu.

En fait la déclaration en 64 bits doit être:

Private Declare PtrSafe Function MonitorFromPoint Lib "user32.dll" (ByVal pt As LongLong, ByVal dwFlags As Long) As LongPtr

Et l'appel doit tenir compte du type LongLong de l'argument pour que l'argument dwFlags soit vu.

 

[Dudu2]

tu dis que ça peut marcher su N perso j'en suis pas sur
tu ne fait que visiter la gauche avec le monitorfrompoint(negatif )
qui sait on peut en avoir 1 de chaque coté du point(0,0)

Le point (0,0) n'arrête pas le scan. D'ailleurs dans ce cas, il ne trouverait pas ton moniteur unique en (0,0).
C'est un scan horizontal qui va trouver tous les moniteurs s'il n'y a que des moniteur juxtaposés horizontalement.

 

[Dudu2]

Mais il y a aussi des moniteurs potentiellement en-dessous, et à différents endroits:

Donc il faut revoir le scan et c'est compliqué, car il ne suffit pas d'ajouter un scan vertical !

 

[Dudu2]

Je pense que pour chaque moniteur détecté (en commençant par celui le plus à gauche qu'on trouve en X = -10 ^ 6, Y = 1 et MONITOR_DEFAULTTONEAREST) , il faut faire un scan horizontal et un scan vertical en éliminant les doublons évidemment. Ça sent la récursivité. Je verrai ça ce soir...

 

[Dudu2]

@patricktoulon,
J'ai fait des essais en tous genres sur 2 moniteurs. Les 2 écrans peuvent être placés cote à cote alignés ou pas, voire même coin contre coin, ce qui donne de nombreuses configurations possibles.

Avec 3 écrans c'est encore pire car on peu avoir des juxtapositions au niveau horizontal ou vertical du type:

Ma conclusion est que l'algorithme de recherche des moniteurs serait trop compliqué à gérer même si théoriquement possible sachant qu'on dispose d'une méthode avec EnumDisplayMonitors() fonctionnelle.

 

[Dudu2]

Au final, c'est plus simple comme ça et c'est garanti correct.
Mais évidemment ce n'est pas utilisable dans un UserForm ou Module de Classe à cause de l'AddressOf de la fonction EnumDisplayMonitors().

Ça s'appelle un retour à la case départ !

Edit: fichier supprimé, voir plus loin.

 

[Dranreb]

Bonsoir.

Mais évidemment ce n'est pas utilisable dans un UserForm ou Module de Classe à cause de l'AddressOf de la fonction EnumDisplayMonitors().

Non, il ne faut pas dire ça mais, mais plutôt: ce n'est utilisable dans un module objet qu'en faisant appel au service d'un module standard. Mais le plus gros peut s'écrire dans l'UserForm.

 

[patricktoulon]

Mais il y a aussi des moniteurs potentiellement en-dessous, et à différents endroits:

Regarde la pièce jointe 1182839 Regarde la pièce jointe 1182840 Regarde la pièce jointe 1182841

Donc il faut revoir le scan et c'est compliqué, car il ne suffit pas d'ajouter un scan vertical !

non sérieux tu a déjà vu des config comme ça toi
ta copié ça sur tetris ou quoi

la config la plus courante est l'horizontale
le point(0,0,MONITOR_DEFAULTTONEAREST )te donne le point entre deux ecran


tu a 3 test a faire c'est tout
ecran milieu=monitorfrompoint(100,100,MONITOR_DEFAULTTONEAREST

ecrangauche=monitorfrompoint(-100,100,MONITOR_DEFAULTTONEAREST

ecrandroite=monitorfrompoint(mi.rcmonitor.right+100,100,MONITOR_DEFAULTTONEAREST

tu compare les 3 tu saura le quel est le gauche , le milieu et le droite
ou le gauche et droite si 2 d'entre eux sont identique
ou si tu n'a q'un ecran
pas compliqué

 

[Dudu2]

Bonjour,
Suis d'accord avec vos remarques.

Cependant, une petite frustration reste de ne pas avoir cet algorithme ultime pour détecter tous les moniteurs par proximité. Ça serait un truc assez faisable dont je vois le principe comme suit:

1. Trouver par n'importe quel moyen un Moniteur en MONITOR_DEFAULTTONEAREST
   En démarrant à X = -10 ^ 6 et Y = -10 ^ 6 ça devrait le faire.
   
   
2. Parcourir toutes ses bordures disons de 100 px en 100 px plus 1 point extérieur à la bordure pour trouver un moniteur adjacent en MONITOR_DEFAULTTONULL. Attention aux coins qui nécessitent à la fois +1 point en X ET Y.
   Ça implique de respecter la différenciation de déclaration 32/64bits de MonitorFromPoint() comme indiqué plus haut.
   
   
3. Pour chaque moniteur détecté, vérifier s'il est inconnu au bataillon, et s'il l'est repartir en 2 sur un appel récursif du code.

Ça doit pouvoir se faire mais concentrer le code sera une nécessité de présentation et une gageure notamment pour avoir une séquence si possible unique pour les 4 bordures.

 

[patricktoulon]

re
ce matin vite fait j'ai fait ça pour l'horizontal

 

[Dudu2]

Bon, ben finalement ce n'est pas si difficile...
Sur 2 moniteurs ça détecte toutes les configurations (2-1 ou 1-2), y compris la juxtaposition en coin.
Je n'ai pas regroupé les 4 boucles de scan latérales, elles sont vraiment courtes.

Edit: Fichier supprimé, voir plus loin.