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関連

    Acrobat XIを操作してテキスト認識操作を行うVBAマクロ

    マクロからAcrobatを操作する場合「PDFファイル上のフィールドの…

  2. Office関連

    Data Explorerのフォーラム&ブログ

    前回の記事で紹介した「Data Explorer」ですが、すでにフォー…

  3. アイコン一覧

    Office 365アイコン(imageMso)一覧(N)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  4. Office関連

    Chromeアプリ版Office Onlineを使ってみました。

    「Microsoft、GoogleのChromeアプリ版Office …

  5. Office関連

    オデッセイ コミュニケーションズ主催のExcel VBA入門セミナーに参加しました。

    今月19日に開催されたオデッセイ コミュニケーションズさん主催の「Ex…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP