用户窗体根据屏幕分辨率调整大小

Question

我有一个 Excel 用户表单，我想在打开时调整大小以适应屏幕分辨率。

Application.Height我通过和获取高度和宽度Application.Width，通常使用这两个参数和以下代码，应该可以解决问题：

Me.Top = Application.Top
Me.Left = Application.Left
Me.Height = Application.Height
Me.Width = Application.Width

问题是：Windows（至少从 7 开始）有一个参数可以设置桌面缩放，这似乎会损害代码。

例如，当从 100% 更改为 150% 时，表单的宽度和高度设置正确，但缩放不正确。我想根据 Windows 桌面缩放来更改它。

如何检索桌面缩放参数？

Answer 1

尝试这个：

Option Explicit
'Function to get screen resolution
#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As LongPtr) As Long
    'Functions to get DPI
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr 
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
#Else
    Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
    'Functions to get DPI
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
#End If
Private Const LOGPIXELSX = 88  'Pixels/inch in X
Private Const POINTS_PER_INCH As Long = 72 'A point is defined as 1/72 inches

'Return DPI
Public Function PointsPerPixel() As Double
'hDC LongPtr if VBA7
 Dim hDC As Long
 Dim lDotsPerInch As Long

 hDC = GetDC(0)
 lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
 PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
 ReleaseDC 0, hDC
End Function

Private Sub UserForm_Initialize()

Dim w As Long, h As Long
    w = GetSystemMetrics32(0) ' Screen Resolution width in points
    h = GetSystemMetrics32(1) ' Screen Resolution height in points
With Me
    .StartUpPosition = 2
    .Width = w * PointsPerPixel * 0.5 'Userform width= Width in Resolution * DPI * 50%
    .Height = h * PointsPerPixel * 0.5 'Userform height= Height in Resolution * DPI * 50%
End With
End Sub