Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Monitorauflösung per Excel einstellen | Herbers Excel-Forum


Betrifft: Monitorauflösung per Excel einstellen von: PointOfView
Geschrieben am: 14.01.2010 18:20:50

Hallo Rainer,

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



Betrifft: Monitoreinstellung /-auflosung
von: PointOfView
Geschrieben am: 16.12.2009 16:24:44

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



Betrifft: Korrekturbedarf.,..
von: Ramses
Geschrieben am: 16.12.2009 17:40:47

Hallo wer auch immer

VBA Objectfehler beim öffnen der Datei
Die Auflösung wird nicht korrekt ausgelesen

Vista und Office 2003 / 2007

Gruss Rainer



Betrifft: AW: Korrekturbedarf.,..
von: ransi
Geschrieben am: 16.12.2009 18:14:59

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

  

Betrifft: AW: Monitorauflösung per Excel einstellen von: MichaV
Geschrieben am: 14.01.2010 22:19:47

öhm, hier mal ne Lösung vom 28.11.2009.

https://www.herber.de/bbs/user/66206.xls

Gruss- Micha


  

Betrifft: Nachtrag von: MichaV
Geschrieben am: 14.01.2010 22:25:58

hier die ganze Geschichte.

https://www.herber.de/forum/archiv/1120to1124/t1120068.htm


  

Betrifft: AW: Nachtrag von: PointOfView
Geschrieben am: 15.01.2010 12:08:47

Hallo Micha,

sehr cool!!! Danke.
Ich hab ein paar höhere Auflösungen (schön für große Monitore) zusätzlich drin.

Viele Grüsse
PointOfView
Oliver


  

Betrifft: AW: Nachtrag von: MichaV
Geschrieben am: 15.01.2010 12:53:46

ja aber das bringt nix wenn die nicht unterstützt werden. Bei "meiner" Lösung werden nur und dafür aber auch alle verfügbaren Auflösungen angezeigt, egal wie gross die mal sein werden.

Gruss- Micha


 

Beiträge aus den Excel-Beispielen zum Thema "Monitorauflösung per Excel einstellen"

Einstellen des Drucker-Papiereinzug-Schachts