CODEWITHSUNDEEP
excelvbascreen-resolution
Przemyslaw Remin
Przemyslaw Remin

Reputation: 6940

Get Windows display zoom value

Is there any way to get display zoom value of Windows? The 200% in the picture is exactly what I would like to get.
enter image description here

This question is only half the means to achieve another purpose, which is formulated in that question: Excel Shape position disturbed by Windows Display Zoom settings

Upvotes: 2

Views: 4543

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57673

You can retrieve this information with a WIN32-API call

Option Explicit

Private Const LOGPIXELSX As Long = 88

#If VBA7 Then
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" (ByVal hdc As LongPtr, ByRef lprcClip As Any, ByVal lpfnEnum As LongPtr, ByVal dwData As Long) As Long
#Else
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Long
#End If

Public Function GetDpi() As Long
    #If VBA7 Then
        Dim hdcScreen As LongPtr
        Dim hWnd As LongPtr
    #Else
        Dim hdcScreen As Long
        Dim hWnd As Long
    #End If
    
    hWnd = GetActiveWindow()
    hdcScreen = GetDC(hWnd)

    Dim iDPI As Long
    iDPI = -1

    If (hdcScreen) Then
        iDPI = GetDeviceCaps(hdcScreen, LOGPIXELSX)
        ReleaseDC hWnd, hdcScreen
    End If

    GetDpi = iDPI
End Function

This will result in 192 for eg 200%:

  • 96 – Smaller 100%
  • 120 – Medium 125%
  • 144 – Larger 150%
  • 192 – Extra Large 200%
  • 240 – Custom 250%
  • 288 – Custom 300%
  • 384 – Custom 400%
  • 480 – Custom 500%

Upvotes: 3

Related Questions