VBA获取显示大小比例

cuixiaodan

求代码，自动获取显示字体的大小比例，100%或125%，如图，谢谢

gdfcx

1. bl=ActiveWindow.Zoom

复制代码

cuixiaodan

这样返回的是窗口的缩放比例，我想要的是电脑设置的显示比例，不仅仅是Excel的，整个系统的

Cellfarmer

我也有同样的需求！请大侠指导！

lss001

Declare Function GetDeviceCaps Lib "gdi32" _
    (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Const LOGPIXELSX = 88, LOGPIXELSY = 90
Sub DesktopZoom()
    '当前程序缩放比例：x = ActiveWindow.Zoom
   'Zoomx = GetDeviceCaps(GetDC(0), LOGPIXELSX)
    Zoomy = GetDeviceCaps(GetDC(0), LOGPIXELSY)
    Select Case Zoomy
        Case 96: dpi = 1: std = "100%"
        Case 120: dpi = 1.25: std = "125%"
        Case 144: dpi = 1.5: std = "150%"
        Case 192: dpi = 2: std = "200%"
    End Select
    MsgBox "当前屏幕缩放比例" & std
End Sub

lixiaopan0502

lss001 发表于 2019-12-10 15:27
Declare Function GetDeviceCaps Lib "gdi32" _
    (ByVal hdc As Long, ByVal nIndex As Long) As Long
...

大神？这个好像不能在64位上运行。请看截图

lixiaopan0502

Cellfarmer 发表于 2019-11-23 18:29
我也有同样的需求！请大侠指导！

你的问题解决了吗？

lss001

lixiaopan0502 发表于 2020-4-5 17:50
大神？这个好像不能在64位上运行。请看截图

'64位加上PtrSafe即可
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" _
    (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private

Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Const LOGPIXELSX = 88, LOGPIXELSY = 90
Sub DesktopZoom()
    '当前程序缩放比例：x = ActiveWindow.Zoom
   'Zoomx = GetDeviceCaps(GetDC(0), LOGPIXELSX)
    Zoomy = GetDeviceCaps(GetDC(0), LOGPIXELSY)
    Select Case Zoomy
        Case 96: dpi = 1: std = "100%"
        Case 120: dpi = 1.25: std = "125%"
        Case 144: dpi = 1.5: std = "150%"
        Case 192: dpi = 2: std = "200%"
    End Select
    MsgBox "当前屏幕缩放比例" & std
End Sub