Récupération de la résolution de plusieurs écran

[Jo_VBA]

Bonjour à tous,

Cela fait un moment que je cherche sur le web un bout de code, solutions, explications pour pouvoir récupérer la résolution de plusieurs écran connecté à 1 PC sans résultat.

Actuellement j'utilise le code ci-dessous, récupéré sur le net et mit à ma sauce, qui me permet de connaitre le ratio et ainsi redimensionner mon interface à l'écran.

Par contre si l'utilisateur ouvre le fichier excel sur son écran secondaire et que celui-ci n'a pas le même ratio, l'interface est dimensionné pour l'écran principal ! Ce qui est mon cas, mon écran principal a une résolution 16/9 et mon écran secondaire une résolution 4/3.

Voici le code actuel :

Option Explicit
Private Declare PtrSafe Function GetDC Lib "User32" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "User32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Declare PtrSafe Function GetSystemMetrics Lib "User32" (ByVal nIndex As Long) As Long
'
Private Const LOGPIXELSX = 88 'Pixels/inch in X
'
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72

Public Const SM_CXSCREEN = 0

Public Const SM_CYSCREEN = 1



Function Rez_Display()

    'This function determined the ratio of the MAIN display of the user's computer
    'Function result is equal at :
    '169 = 16/9 screen (i.e.1920x1080)
    '43   = 4/3 screen (i.e. 1024x768)
    '54   = 5/4 screen (i.e. 1280x1024)
    
    Dim LargeurVid As Long, HauteurVid As Long

    LargeurVid = GetSystemMetrics(SM_CXSCREEN)
    HauteurVid = GetSystemMetrics(SM_CYSCREEN)

    If LargeurVid / HauteurVid * 9 = 16 And HauteurVid / LargeurVid * 16 = 9 Then
        Rez_Display = 169
    ElseIf LargeurVid / HauteurVid * 3 = 4 And HauteurVid / LargeurVid * 4 = 3 Then
        Rez_Display = 43
    ElseIf LargeurVid / HauteurVid * 4 = 5 And HauteurVid / LargeurVid * 5 = 4 Then
        Rez_Display = 54
    Else
        Rez_Display = 169
    End If
End Function

Donc si quelqu'un sait comment récupérer la résolution de l'écran secondaire, c'est très volontier 🙂

 

[david84]

Re : Récupération de la résolution de plusieurs écran

Je ne peux déchiffrer la première capture d'écran donc difficile de t'en dire plus...
Je n'ai pas de réponse sur le coup mais cela n'est a priori pas logique.
Si la procédure est amenée à tourner sur d'autres machines par sécurité je préconiserais tout de même de prévoir les 2 cas de figure.
A+

 

[Jo_VBA]

Re : Récupération de la résolution de plusieurs écran

Bonjour,

Si cela peut vous aider voici un code pour énumérer les différents écrans

'### APIs déclarations pour 32 bits ###
Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" ( _
  ByVal hMonitor As Long, ByRef lpmi As MONITORINFOEX) As Long
Declare Function MonitorFromPoint Lib "user32.dll" ( _
  ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As Long
Declare Function MonitorFromRect Lib "user32.dll" ( _
  ByRef lprc As RECT, ByVal dwFlags As Long) As Long
Declare Function MonitorFromWindow Lib "user32.dll" ( _
  ByVal hwnd As Long, ByVal dwFlags As Long) As Long
Declare Function EnumDisplayMonitors Lib "user32.dll" ( _
  ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Long
Declare Function GetWindowRect Lib "user32" ( _
  ByVal hwnd As Long, lpRect As RECT) As Long

'### Constantes et types (structures) ###
Const MONITORINFOF_PRIMARY = &H1
Const MONITOR_DEFAULTTONEAREST = &H2
Const CCHDEVICENAME = 32

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

Type MONITORINFOEX
  cbSize As Long
  rcMonitor As RECT
  rcWork As RECT
  dwFlags As Long
  szDevice As String * CCHDEVICENAME
End Type

'### Variable de portée module ###
Dim A$

Sub EnumEcrans()
A$ = ""
EnumDisplayMonitors ByVal 0&, ByVal 0&, AddressOf MonitorEnumProc, ByVal 0&
MsgBox A$
End Sub

Public Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, lprcMonitor As RECT, ByVal dwData As Long) As Long
Dim MI As MONITORINFOEX
Dim REC As RECT
'--- Structure MONITORINFO ---
MI.cbSize = Len(MI)
GetMonitorInfo hMonitor, MI
'--- Obtention des infos ---
A$ = A$ & "Moniteur Handle : " & CStr(hMonitor) & vbLf
'---
A$ = A$ & "Moniteur nom : " & Mid(MI.szDevice, 1, InStr(1, MI.szDevice, Chr(0)) - 1) & vbLf
'---
With MI.rcMonitor
  A$ = A$ & "Moniteur Width/Height : " + CStr(.Right - .Left) + "x" + CStr(.Bottom - .Top) & vbLf
End With
'---
With MI.rcWork
  A$ = A$ & "Moniteur Width/Height (surface de travail) : " + CStr(.Right - .Left) + "x" + CStr(.Bottom - .Top) & vbLf
End With
'---
A$ = A$ & "Moniteur principal : " + CStr(CBool(MI.dwFlags = MONITORINFOF_PRIMARY)) & vbLf
'---
If MonitorFromWindow(Application.hwnd, MONITOR_DEFAULTTONEAREST) = hMonitor Then
  A$ = A$ & "Excel apparaît sur ce moniteur" & vbLf
End If
'---
If MonitorFromPoint(0, 0, MONITOR_DEFAULTTONEAREST) = hMonitor Then
  A$ = A$ & "Le point ( 0 , 0 ) se trouve dans la portée de ce moniteur" & vbLf
End If
'---
GetWindowRect Application.hwnd, REC
If MonitorFromRect(REC, MONITOR_DEFAULTTONEAREST) = hMonitor Then
  A$ = A$ & "La fenêtre Excel se trouve dans ce moniteur" & vbLf
End If
'---
A$ = A$ & vbLf
'--- Suite de l'énumération ---
MonitorEnumProc = 1
End Function

A NOTER :
1) Je ne possède qu'un seul écran et je n'ai pas pu tester si cela fonctionne avec plusieurs.
2) Je suis en 32 bits et il faudra adapter les déclarations APIs et les structures qui sont employées au 64 bits.

Bonjour à tous,

Je reviens vers vous concernant la réponse de PMO2.

Je suis en train de reprendre mon code pour les 2 écrans.

Est-ce que quelqu'un pourrait me mettre une ligne de code où la résolution de l'écran qui est récupéré à partir de "MI.rcMonitor" dans la fonction "MonitorEnumProc" soit utilisable dans une variable dans la sub EnumEcrans().

Pour l'instant tout est concaténé dans la variable A$...
De plus c'est la première fois que je code qqch de ce genre, je dois bien l'avoué je patauge dans la semoule pour comprendre le fonctionnement de ce code (imbrication de function avec addressof, etc...)

Un grand merci d'avance !

 

[Roland_M]

Re : Récupération de la résolution de plusieurs écran

bonjour à tous,

sinon, en faisant simple, sans la précision des API mais toujours compatible à 100% :
Public Function FResolutionXwinPixel(): FResolutionXwinPixel = (Application.Width - 12) / 0.75: End Function
Public Function FResolutionYwinPixel(): FResolutionYwinPixel = (Application.Height + 18) / 0.75: End Function


faire essai avec:
Sub Essai()
MsgBox FResolutionXwinPixel & "x" & FResolutionYwinPixel
End Sub

 

[Jo_VBA]

Re : Récupération de la résolution de plusieurs écran

bonjour à tous,

sinon, en faisant simple, sans la précision des API mais toujours compatible à 100% :
Public Function FResolutionXwinPixel(): FResolutionXwinPixel = (Application.Width - 12) / 0.75: End Function
Public Function FResolutionYwinPixel(): FResolutionYwinPixel = (Application.Height + 18) / 0.75: End Function


faire essai avec:
Sub Essai()
MsgBox FResolutionXwinPixel & "x" & FResolutionYwinPixel
End Sub

C'est à peut prêt ce que j'utilise maintenant.

J'aimerais justement pousser plus loin pour avoir les Infos du 2ème écran si l'utilisateur glisse la fenêtre Excel dessus (principal raison).

Mais également faire des calculs de ratio des écrans afin d'adapter mes feuilles de calculs.

 

[david84]

Re : Récupération de la résolution de plusieurs écran

Bonjour,

st-ce que quelqu'un pourrait me mettre une ligne de code où la résolution de l'écran qui est récupéré à partir de "MI.rcMonitor" dans la fonction "MonitorEnumProc" soit utilisable dans une variable dans la sub EnumEcrans().

Quel est l'intérêt de faire cela ?
Si tu veux simplement récupérer la résolution des écrans il te suffit de ne garder que cette information :

Public Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, lprcMonitor As RECT, ByVal dwData As Long) As Long
Dim MI As MONITORINFOEX
'--- Structure MONITORINFO ---
MI.cbSize = Len(MI)
GetMonitorInfo hMonitor, MI

With MI.rcMonitor
  A$ = A$ & "Moniteur Width/Height : " + CStr(.Right - .Left) + "x" + CStr(.Bottom - .Top) & vbLf
End With
''---
'With MI.rcWork
'  A$ = A$ & "Moniteur Width/Height (surface de travail) : " + CStr(.Right - .Left) + "x" + CStr(.Bottom - .Top) & vbLf
'End With

''--- Suite de l'énumération ---
MonitorEnumProc = 1
End Function

A+

 

[Jo_VBA]

[RESOLU ]Re : Récupération de la résolution de plusieurs écran

Bonjour,

Pour répondre à David84, je devais avoir de l'eau dans le cerveau...

En fait, j'ai créé 2 variables (dHeight et dWidth dans le code ci-dessous) de portée module qui vont être écrite dans la fonction et lue dans le module.

Le reste, comme tu l'as déjà mentionné, a été mis en commentaire.

Je dois encore paufiné pour que le numéro de moniteur soit prit en compte mais c'est qu'une affaire de temps.


Merci à tous pour votre aide !

Public Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, lprcMonitor As RECT, ByVal dwData As Long) As Long
Dim MI As MONITORINFOEX
Dim REC As RECT
Dim LTot As Variant
Dim i As Integer
 
'--- Structure MONITORINFO ---
MI.cbSize = Len(MI)
GetMonitorInfo hMonitor, MI
'--- Obtention des infos ---
'A$ = A$ & "Moniteur Handle : " & CStr(hMonitor) & vbLf
'---
'A$ = A$ & "Moniteur nom : " & Mid(MI.szDevice, 1, InStr(1, MI.szDevice, Chr(0)) - 1) & vbLf
'---
With MI.rcMonitor
  'A$ = A$ & "Moniteur Width/Height : " + CStr(.Right) + " left " + CStr(.Left) + "x" + CStr(.Bottom - .Top) & vbLf
  dHeight = .Bottom - .Top
  dWidth = .Right - .Left
End With

'---
'With MI.rcWork
'  A$ = A$ & "Moniteur Width/Height (surface de travail) : " + CStr(.Right - .Left) + "x" + CStr(.Bottom - .Top) & vbLf
'End With
'---
'A$ = A$ & "Moniteur principal : " + CStr(CBool(MI.dwFlags = MONITORINFOF_PRIMARY)) & vbLf
'---
'If MonitorFromWindow(Application.hwnd, MONITOR_DEFAULTTONEAREST) = hMonitor Then
'  A$ = A$ & "Excel appara羡 sur ce moniteur" & vbLf
'End If
'---
'If MonitorFromPoint(0, 0, MONITOR_DEFAULTTONEAREST) = hMonitor Then
'  A$ = A$ & "Le point ( 0 , 0 ) se trouve dans la port馥 de ce moniteur" & vbLf
'End If
'---
'GetWindowRect Application.hwnd, REC
If MonitorFromRect(REC, MONITOR_DEFAULTTONEAREST) = hMonitor Then
'  A$ = A$ & "La fen黎re Excel se trouve dans ce moniteur" & vbLf
'  End If

'---
'A$ = A$ & vbLf
'--- Suite de l'駭um駻ation ---
MonitorEnumProc = 1
End Function