ディスプレイのサイズを取得するVBAマクロ

ホーム
Excel, Office関連, Word, PowerPoint
ディスプレイのサイズを取得するVBAマクロ

2016.09.28

ディスプレイのサイズを取得するVBAマクロ

「VBA ディスプレイ幅高さ」といったキーワード検索でのアクセスがありました。
マクロでディスプレイの解像度を取得する方法を探している方だろうと思います。

マクロでディスプレイの高さや幅を取得する場合、手軽なのはWMIの「Win32_DesktopMonitor」クラスや「Win32_VideoController」クラスを利用する方法です。

Public Sub Sample1()
'Win32_DesktopMonitorクラス利用
  Dim items As Object
  Dim item As Object

  Set items = CreateObject("WbemScripting.SWbemLocator") _
              .ConnectServer.ExecQuery("Select * From Win32_DesktopMonitor")
  For Each item In items
    Debug.Print "Name:" & item.Name, _
                "DeviceID:" & item.DeviceID, _
                "ScreenWidth:" & item.ScreenWidth, _
                "ScreenHeight:" & item.ScreenHeight
  Next
End Sub

Public Sub Sample2()
'Win32_VideoControllerクラス利用
  Dim items As Object
  Dim item As Object
  
  Set items = CreateObject("WbemScripting.SWbemLocator") _
              .ConnectServer.ExecQuery("Select * From Win32_VideoController")
  For Each item In items
    Debug.Print "Caption:" & item.Caption, _
                "DeviceID:" & item.DeviceID, _
                "CurrentHorizontalResolution:" & item.CurrentHorizontalResolution, _
                "CurrentVerticalResolution:" & item.CurrentVerticalResolution
  Next
End Sub

ただ、こちらの記事によると、正しくサイズを取得できない場合もあるようなので、PowerShell経由で.NETの「Screen.AllScreens」プロパティから値を取得するコードも考えてみました。

Public Sub Sample3()
'System.Windows.Forms.Screen.AllScreensプロパティ利用
  Dim cmd As String
  Dim ret As String
  Dim v As Variant, vv As Variant
  Dim i As Long
   
  'PowerShellの実行確認
  On Error Resume Next
  Shell "PowerShell -Version", vbHide
  If Err.Number <> 0 Then Exit Sub
  On Error GoTo 0
  
  cmd = "PowerShell -Command Add-Type -AssemblyName System.Windows.Forms;$str='';foreach($item in [Windows.Forms.Screen]::AllScreens){$str+=$item.DeviceName+','+$item.BitsPerPixel+','+$item.Primary+','+$item.Bounds.Width+','+$item.Bounds.Height+':'};$str=$str.Remove($str.Length-1,1);Write-Host $str;"
  ret = CreateObject("WScript.Shell").Exec(cmd).StdOut.ReadLine
  v = Split(ret, ":") 'PowerShellの実行結果を指定した区切り文字で分割
  For i = LBound(v) To UBound(v)
    vv = Split(v(i), ",")
    Debug.Print "DeviceName:" & vv(0), _
                "BitsPerPixel:" & vv(1), _
                "Primary:" & vv(2), _
                "Width:" & vv(3), _
                "Height:" & vv(4)
  Next
End Sub

PowerShellが実行できる環境が前提となりますが、WMIで上手くいかない場合は、こちらのコードもお試しください。