Office関連

ディスプレイのサイズを取得する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で上手くいかない場合は、こちらのコードもお試しください。

参考Webページ

関連記事

  1. Office関連

    jQuery UIのDatepickerをVBAから使用するサンプル

    2014/1/31 追記:Internet Explorerのオー…

  2. Office関連

    マクロでリボンを最小化する。

    mougの回答用に書いたコードです。忘れないうちにメモ。・…

  3. Office関連

    Office 2019 Commercial Preview版のインストール方法

    「Microsoft、「Office 2019 Commercial …

  4. Office アドイン

    [Office用アプリ]Google ドライブでアプリを公開する方法

    今回は先日登壇した第一回 Apps for Office 勉強会の中で…

  5. Office関連

    Excel 2013 新関数一覧

    「関数一覧(Excel 2010)」と「関数一覧(Excel 2013…

  6. Office関連

    Outlookの連絡先をvcf形式で一括保存する方法

    Outlookの連絡先をvcf形式で保存する場合、通常は「連絡先を v…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP