Monitorauflösung per Excel einstellen
PointOfView
Sorry, dass ich mich erst jetzt wieder melde (Asche über mein Haupt). Du hast völlig Recht. Hatte die Prozedur für diesen Zellschutz nicht ganau beachtet.
Wollte eine aktualisierte Datei hochladen, geht aber zur Zeit überhaupt nicht, und bricht permanent (unabhängig diverser Dateitypen und Endungen die ich probierte) ab. Ich probier es ein anderes mal wieder.
Im Tabellenblatt "Modi" sind die mir bekannten Auflösungen eingetragen:
Spalte G Spalte H Spalte I
Auflösungen
ab Zeile16 CGA 320x200 320 200
QVGA 320x240 320 240
VGA 640x480 640 480
4CIF 704x480 704 480
4CIF 704x576 704 576
NTSC 720x480 720 480
PAL 768x576 768 576
WVGA 854x480 854 480
SVGA 800x600 800 600
HDT 960x720 960 720
PAL-Wide 1024x576 1024 576
XGA 1024x768 1024 768
9CIF 1056x720 1056 720
9CIF 1056x864 1056 864
1152x768 1152 768
HD 720 1280x720 1280 720
1280x854 1280 854
1280x960 1280 960
SXGA 1280x1024 1280 1024
16CIF 1408x960 1408 960
16CIF 1408x1152 1408 1152
SXGA+ 1400x1050 1400 1050
1440x960 1440 960
HD 1080 1440x1080 1440 1080
HD 1152 1440x1152 1440 1152
HD 1152 1536x1152 1536 1152
1600x900 1600 900
UXGA 1600x1200 1600 1200
WSXGA+ 1680x1050 1680 1050
MUSE 1920x1035 1920 1035
HD1080 1920x1080 1920 1080
WUXGA 1920x1200 1920 1200
2K 2048x1080 2048 1080
HD 1152 2048x1152 2048 1152
QXGA 2048x1536 2048 1536
DCI 2K 2048x1556 2048 1556
WQXGA 2560x1600 2560 1600
QSXGA 2560x2048 2560 2048
Im Tabellenblatt "Auflösung" erfolgt die Auswahl "neue Auflösung" und Anzeige "vorhandene Auflösung"
Vorab einfach mal die Codes:
In die Arbeitsmappe:
Private Sub Workbook_Open()
Call Auflösung_ermitteln
End Sub
In ein Modul (Bsp. basAuflösung_ermitteln):
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Const HORZRES = 8
Const VERTRES = 10
Function ScreenResolution()
Dim lRval As Long
Dim lDc As Long
Dim lHSize As Long
Dim lVSize As Long
lDc = GetDC(0&)
lHSize = GetDeviceCaps(lDc, HORZRES)
lVSize = GetDeviceCaps(lDc, VERTRES)
lRval = ReleaseDC(0, lDc)
ScreenResolution = lHSize & "x" & lVSize
End Function
Sub Auflösung_ermitteln()
Sheets("Auflösung").Range("B9").Value = ScreenResolution() 'Tabellenblattname sollte den eigenen Bedürfnissen angepasst werden.
End Sub
In ein weiteres Modul (Bsp. Auflösung):
Private Declare Function EnumDisplaySettings Lib "user32" Alias _
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, _
ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias _
"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Dim DevM As DEVMODE
Private Sub ChangeScreenResolution(iWidth As String, iHeight As String)
Dim a As Boolean
Dim i&
Dim b&
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
b = ChangeDisplaySettings(DevM, 0)
End Sub
Sub ChangeScreen()
Dim Breite As String
Dim Höhe As String
Breite = Sheets("Modi").Range("K20").Value 'Tabellenblattname sollte den eigenen Bedürfnissen angepasst werden.
Höhe = Sheets("Modi").Range("K22").Value 'Tabellenblattname sollte den eigenen Bedürfnissen angepasst werden.
Call ChangeScreenResolution(Breite, Höhe)
Sheets("Auflösung").Range("B9").Value = "" 'Tabellenblattname sollte den eigenen Bedürfnissen angepasst werden.
Call Auflösung_ermitteln
End Sub
Sub Auflösung_auswählen()
Sheets("Auflösung").Range("B5").Value = "" 'Tabellenblattname sollte den eigenen Bedürfnissen angepasst werden.
End Sub
Sub Auflösung_behalten()
Sheets("Auflösung").Range("B9").Value = "" 'Tabellenblattname sollte den eigenen Bedürfnissen angepasst werden.
End Sub
Viele Grüsse
PointOfView
Oliver
Hallo,
ein kleines aber feines Tool um die Monitorauflösung per Excel anzupassen.
https://www.herber.de/bbs/user/66639.zip
Viel Spaß damit.
PointOfView
Hallo wer auch immer
VBA Objectfehler beim öffnen der Datei
Die Auflösung wird nicht korrekt ausgelesen
Vista und Office 2003 / 2007
Gruss Rainer
HAllo
VBA Objectfehler beim öffnen der Datei.
Wenn du in Auflösung!B9 die ScreenResolution() reinschreiben willst darfst du dazu die Zelle nicht schützen.
ransi