分享VBA提示框显示屏幕缩进比例代码,支持64位和32位,支持wps

'获取屏幕DPI值

#If VBA7 Then '如果是64位的Office
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "Gdi32" (ByVal hdc As Long, ByVal index As Long) As Long
#Else
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "Gdi32" (ByVal hdc As Long, ByVal index As Long) As Long
#End If

Sub 豪情云天()
    Select Case GetDeviceCaps(GetDC(0), 88)
        Case 96: MsgBox "Windows系统当前的全局缩放比例为 100%", vbInformation, "豪情云天"
        Case 120: MsgBox "Windows系统当前的全局缩放比例为 125%", vbInformation, "豪情云天"
        Case 144: MsgBox "Windows系统当前的全局缩放比例为 150%", vbInformation, "豪情云天"
        Case 168: MsgBox "Windows系统当前的全局缩放比例为 175%", vbInformation, "豪情云天"
        Case 192: MsgBox "Windows系统当前的全局缩放比例为 200%", vbInformation, "豪情云天"
    End Select
End Sub