ディスプレイの拡大率取得

質問

コントローパネルのディスプレイから、「デスクトップ上のテキスト～～縮小拡大」の処

小　100％
中　125％
大　150％

で変更ができますが、この拡大率をVBで取得する方法を教えて下さい。

アクセス2013　VBA使用です。

回答No.2

NotFound404 · ベストアンサー

すみません、WindowsXPの時は問題なかったのですが、
７ で試すと、96 から変わりませんね。。。。
（Win7 64bit Access2010 32bit で検証）
API 版ですがこちらはどうですか？（当方では可）
こちらも標準モジュールにコピペです。

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90

Private Declare Function GetDesktopWindow Lib "user32" () As Long

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

Public Function Are2() As Long
Dim hWndDesk As Long
Dim hDCDesk As Long
Dim logPix As Long

On Error GoTo Err1:

hWndDesk = GetDesktopWindow()
hDCDesk = GetDC(hWndDesk)

'画面のフォントサイズを取得
Are2 = GetDeviceCaps(hDCDesk, LOGPIXELSX)

Call ReleaseDC(hWndDesk, hDCDesk)

Exit Function
Err1:

'エラーの場合は、-1を返す
Are2 = -1
End Function

お礼

こちらは、Win8.1 64bit Access2013 32bit ですが、ご教授頂いたままのコピペで、正常な拡大率を取得することができました。
拡大率=are2/96
感謝、感謝です。
ありがとうございます。

回答No.1

NotFound404

少し手抜きですが標準モジュールにて。

Function are() As Integer
Dim wmi
Dim monitorItems
Dim m
Set wmi = GetObject("winmgmts:\\.\root\cimv2")
Set monitorItems = wmi.ExecQuery("Select * From Win32_DesktopMonitor")

For Each m In monitorItems
are = m.PixelsPeryLogicalInch
Next

Set monitorItems = Nothing: Set wmi = Nothing
End Function

96DPIがデフォルト100%なので、125・150%のそれぞれのDPI値はそちらで確認を。

補足

コントローパネルで拡大率を125%に変えて試しました。
返って来るare値は100％の場合と同じで、９６です。
もう少し、ご教授願えれば幸です。