excel - 获取 Windows 显示缩放值

Question

有没有办法获得 Windows 的显示缩放值？图片中的200%正是我想要得到的。


这个问题只是实现另一个目的的手段的一半，在那个问题中表述为:Excel Shape position disturbed by Windows Display Zoom settings

Answer 1

您可以使用 WIN32-API 调用检索此信息

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

这将导致 192例如 200% :

96 – 更小 100%

120 – 中等 125%

144 – 更大 150%

192 – 超大 200%

240 – 自定义 250%

288 – 自定义 300%

384 – 自定义 400%

480 – 自定义 500%