Userform根据屏​​幕分辨率调整大小

Question

我已经研究了不同的解决方案，但它们似乎都不适合我的问题：我有一个excel-vba用户表单，我想在打开时调整大小以适应屏幕分辨率。我能够通过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 Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As LongPtr) 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
 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 add_file_btn As CommandButton
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

Answer 2

尝试这个：

  Private Sub UserForm_Initialize()
    With Application
    .WindowState = xlMaximized
    Zoom = Int(.Width / Me.Width * 100)
    Width = .Width
    Height = .Height
   End With
  End Sub