'変数の宣言

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

'APIの宣言
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 auto_open()
      ChangeResolution 2
End Sub

Sub auto_close()
      ChangeResolution 3
End Sub