'画面解像度を変更するサンプルマクロ

Option Explicit

Private Const DM_BITSPERPEL = &h40000
Private Const DM_PELSWIDTH = &h80000
Private Const DM_PELSHEIGHT = &h100000
Private Const CDS_UPDATEREGISTRY = &h1&
Private Const CDS_TEST = &h4&
Private Const DISP_CHANGE_SUCCESSFUL = 0&
Private Const DISP_CHANGE_RESTART = 1&

Private Type DEVMODE  '定義を簡略化しています。
    dmDeviceName(0 To 7) As Long
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dummy(0 To 29) As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" ( _
    ByVal lpszDeviceName As Long, _
    ByVal iModeNum As Long, _
    ByRef lpDevMode As Any) As Long

Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" ( _
    ByRef lpDevMode As Any, _
    ByVal dwFlags As Long) As Long


'画面解像度を変更するマクロ

Sub ChangeResolution(iFlag As Long)
    Dim iWidth As Long
    Dim iHeight As Long
    Dim iRet As Long
    Dim dm As DEVMODE

    Select Case iFlag
        Case 1
            iWidth = 640
            iHeight = 480
        Case 2
            iWidth = 800
            iHeight = 600
        Case 3
            iWidth = 1024
            iHeight = 768
        Case Else
            MsgBox "パラメータが不正です。", vbExclamation
            Exit Sub
    End Select

    dm.dmSize = Len(dm)
    dm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    dm.dmPelsWidth = iWidth
    dm.dmPelsHeight = iHeight
    iRet = ChangeDisplaySettings(dm, CDS_TEST)
    Select Case iRet
        Case DISP_CHANGE_RESTART
            iRet = ChangeDisplaySettings(0&, 0)
            MsgBox "再起動の必要があるため変更をキャンセルしました。", _
                vbExclamation
        Case DISP_CHANGE_SUCCESSFUL
            iRet = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
            If iRet = DISP_CHANGE_SUCCESSFUL Then
                MsgBox "画面解像度を変更しました。", vbInformation
            Else
                iRet = ChangeDisplaySettings(0&, 0)
                MsgBox "レジストリの変更に失敗しました。", vbExclamation
            End If
        Case Else
            iRet = ChangeDisplaySettings(0&, 0)
            MsgBox "画面解像度の変更に失敗しました。", vbExclamation
    End Select
End Sub


'テスト用マクロ

Sub Test()
    ChangeResolution 1
End Sub


'設定可能なビット数、ピクセル数を調べるマクロ

Sub Test_EnumDisplaySettings()
    Dim dm As DEVMODE
    Dim i As Long
    i = 0
    Do Until EnumDisplaySettings(0, i, dm) = 0
        Debug.Print dm.dmBitsPerPel, _
            dm.dmPelsWidth, dm.dmPelsHeight
        i = i + 1
    Loop
End Sub