技术问询：如何通过VBA获取Windows系统显示字体大小（100%/125%）

嘿，这个问题我帮不少做桌面程序的开发者解决过——确实，不同用户的Windows显示缩放（就是你说的100%小号、125%中等这类设置）很容易搞乱界面布局，尤其是数据加载工具这种需要精准交互的程序。好在我们可以通过调用Windows API直接获取这个缩放比例，下面是具体的VBA实现：

首先，你需要在模块的最顶部声明必要的API函数（注意不能放在子程序内部）：

Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long

Const LOGPIXELSX = 88 ' 用于获取水平方向每英寸像素数的常量

接下来写一个自定义函数，用来计算并返回当前的显示缩放百分比：

Function GetDisplayScalePercentage() As Integer
    Dim hdc As LongPtr
    Dim currentDPI As Long
    Dim defaultDPI As Long
    
    defaultDPI = 96 ' Windows默认DPI值，对应100%缩放比例
    hdc = GetDC(0) ' 获取桌面窗口的设备上下文
    currentDPI = GetDeviceCaps(hdc, LOGPIXELSX) ' 获取当前系统的水平DPI值
    ReleaseDC 0, hdc ' 释放设备上下文，避免内存泄漏
    
    ' 计算缩放百分比并取整返回
    GetDisplayScalePercentage = Round((currentDPI / defaultDPI) * 100, 0)
End Function

你可以用下面的测试子程序验证效果：

Sub TestDisplayScale()
    MsgBox "当前显示缩放比例为: " & GetDisplayScalePercentage() & "%", vbInformation, "缩放信息"
End Sub

额外说明： #

• 这个方案兼容Windows 7及以上所有版本，包括Windows 10/11的多显示器场景（返回主显示器的缩放比例）。
• 如果你的程序只运行在32位Office环境下，可以去掉代码里的PtrSafe关键字，同时把LongPtr替换成Long。
• 获取到缩放比例后，你就可以针对性地调整程序控件大小、字体尺寸，让界面在不同缩放设置下都能正常适配。

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