Bildschirmauflösung stetig prüfen
orange
ich möchte die Bildschirmauflösung prüfen um zu verhindern, dass die ActivX-Steuerelemente verstümmelt werden. Z. B. bei Virtuellen Maschinen oder zwei Monitorlösungen.
Wie könnte man dies noch lösen? Ich mach dies momentan über einen Timer.
Danke+Gruß
orange
Hier mal mein Ansatz über einen Timer:
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Sub GetScreenDimensions()
lWidth = GetSystemMetrics(SM_CXSCREEN)
lHeight = GetSystemMetrics(SM_CYSCREEN)
End Sub
Public Sub ControlScreenDimensions()
Dim lHeight_old, lWidth_old As Long
lHeight_old = lHeight
lWidth_old = lWidth
Call GetScreenDimensions
If lHeight_old lHeight Or lWidth_old lWidth Then
MsgBox "Sie haben die Bildschirmauflösung geändert! Die Anwendung wird geschlossen!"
ThisWorkbook.Close SaveChanges:=False
End If
If timeout = True Then
Call starten
End If
End Sub
Public Sub starten()
timeout = True
zeit = Time + TimeSerial(0, 0, 1)
Application.OnTime zeit, "ControlScreenDimensions"
End Sub
Anzeige