VBA Tipp: Bildschirmauflösung ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Wie ermittle ich die aktuell eingestellte Bildschirmauflösung in Pixeln?

Lösung

Das geht über die API in einem allgemeinen VBA-Modul und eine der beiden nachstehenden Methoden:

Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
 
#If VBA7 Then
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" ( _
   ByVal nIndex As Long) As Long
#Else  ' VBA6 (für Office Versionen <= 2007)
Private Declare Function GetSystemMetrics Lib "user32" ( _
   ByVal nIndex As Long) As Long
#End If

Version 1 (als Prozedur)

Public Sub GetScreenResolution(XRes As Long, YRes As Long)
 
  'Auflösung in Pixel ermitteln
  'Quelle: www.dbwiki.net oder www.dbwiki.de
 
  XRes = GetSystemMetrics(SM_CXSCREEN)
  YRes = GetSystemMetrics(SM_CYSCREEN)
End Sub

Aufruf

Die Prozedur kann man dann z.B. so verwenden:

   Dim x As Long
   Dim y As Long
 
   GetScreenResolution x, y
   Debug.Print CStr(x) & " x " & CStr(y)
   'Rückgabe: 1024 x 768

Version 2 (als Funktion)

Public Function GetScreenResolution() As Long()
 
   'Auflösung in Pixel ermitteln
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim ScreenResolution(1) As Long
 
   ScreenResolution(0) = GetSystemMetrics(SM_CXSCREEN)
   ScreenResolution(1) = GetSystemMetrics(SM_CYSCREEN)
 
   GetScreenResolution = ScreenResolution
End Function

Aufruf

Die Funktion kann man dann z.B. so verwenden:

   Dim xyRes(1) As Long
 
   xyRes = GetScreenResolution()
   Debug.Print CStr(xyRes(0)) & " x " & CStr(xyRes(1))
   'Rückgabe: 1024 x 768
 
   Debug.Print GetScreenResolution()(0)
   'Rückgabe: 1024
 
   Debug.Print GetScreenResolution()(1)
   'Rückgabe: 768

Weblinks