VBA/Excel/Access/Word/Windows API/Screen Resolution

Get Screen Resolution

   <source lang="vb">

Type MEMORYSTATUS

  dwLength As Long
  dwMemoryLoad As Long
  dwTotalPhys As Long
  dwAvailPhys As Long
  dwTotalPageFile As Long
  dwAvailPageFile As Long
  dwTotalVirtual As Long
  dwAvailVirtual As Long

End Type Type SYSTEM_INFO

  dwOemID As Long
  dwPageSize As Long
  lpMinimumApplicationAddress As Long
  lpMaximumApplicationAddress As Long
  dwActiveProcessorMask As Long
  dwNumberOrfProcessors As Long
  dwProcessorType As Long
  dwAllocationGranularity As Long
  dwReserved As Long

End Type Declare Function abGetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long Sub GetSysInfo()

   Dim intMousePresent As Integer
   Dim strBuffer As String
   Dim intLen As Integer
   Dim MS As MEMORYSTATUS
   Dim SI As SYSTEM_INFO
   Dim strCommandLine As String
   txtScreenResolution = abGetSystemMetrics(SM_CXSCREEN) & " By " & abGetSystemMetrics(SM_CYSCREEN)
   Debug.Print txtScreenResolution
   
   

End Sub

</source>
   
  

Retrieve Display-Resolution Information

   <source lang="vb">

Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long Public Const SM_CXSCREEN = 0 Public Const SM_CYSCREEN = 1 Function VideoRes() As String

   Dim vidWidth
   Dim vidHeight
   
   vidWidth = DisplaySize(SM_CXSCREEN)
   vidHeight = DisplaySize(SM_CYSCREEN)
   
   Select Case (vidWidth * vidHeight)
       Case 307200
           VideoRes = "640 x 480"
       Case 480000
           VideoRes = "800 x 600"
       Case 786432
           VideoRes = "1024 x 768"
       Case Else
           VideoRes = "Something else"
   End Select

End Function Sub CheckDisplayRes()

   Dim VideoInfo As String
   Dim Msg1 As String, Msg2 As String, Msg3 As String
   VideoInfo = VideoRes
   Select Case VideoInfo
       Case Is = "640 x 480"
           Debug.Print "640 x 480"
       Case Is = "800 x 600"
           Debug.Print "800 x 600"
       Case Is = "1024 x 768"
           Debug.Print "1024 x 768"
       Case Else
           MsgBox "Else"
   End Select

End Sub

</source>