Supportnet / Forum / Tabellenkalkulation
Bildschirmauflösung durch Makro ändern
Frage
Hallo Ihr guten Geister,
habe mal wieder ein für mich unlösbares Problem. Gibt es eine Möglichkeit von einem Makro aus Excel heraus, beim öffnen einer Excel-Datei, die Bildschirmauflösung bei Win98/Windows2000 oder WindowsXP von 800x600 auf 1024x768 zu erhöhen und beim Schließen der Excel-Datei dies wieder rückgängig zu machen (800x600). Vielen Dank im voraus.
Gruß Karsten
Antwort 1 von Ahnan
Hallo,
so:
Option Explicit
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 Single, iHeight As Single)
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 ChangeTo800()
Call ChangeScreenResolution(800, 600)
End Sub
Sub ChangeTo1024()
Call ChangeScreenResolution(1024, 768)
End Sub
Private Sub Workbook_Open()
ChangeTo1024
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ChangeTo800
End Sub
Den Code kannst du hier auch nochmal sehen:
http://www.excel-center.de/excel/handbuch.php#Bildschirmauflösung%2...
u. dort unter Bildschirmauflösung ändern !
Bei Excel2000 funzt der Code
MfG
so:
Option Explicit
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 Single, iHeight As Single)
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 ChangeTo800()
Call ChangeScreenResolution(800, 600)
End Sub
Sub ChangeTo1024()
Call ChangeScreenResolution(1024, 768)
End Sub
Private Sub Workbook_Open()
ChangeTo1024
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ChangeTo800
End Sub
Den Code kannst du hier auch nochmal sehen:
http://www.excel-center.de/excel/handbuch.php#Bildschirmauflösung%2...
u. dort unter Bildschirmauflösung ändern !
Bei Excel2000 funzt der Code
MfG
Antwort 2 von kvtv
Hallo Ahnan,
danke erstmal für die schnelle Antwort. Kann man Deine Lösung auch für W98 / W2000 / XP benutzen?Vielen Dank im voraus.
Gruß Karsten
danke erstmal für die schnelle Antwort. Kann man Deine Lösung auch für W98 / W2000 / XP benutzen?Vielen Dank im voraus.
Gruß Karsten
Antwort 3 von Ahnan
Hallo Karsten,
wie von mir beschrieben, kann ich nur bei W2000 testen u. dort geht es. Alles höher entwickelte (XP, 2003..) dürfte ebenfalls unproblematisch sein.. Bei W98 hängt es von der Office-Version ab. Alles was unter Excel2000 ist, könnte es vielleicht problematisch werden. Aber wie gesagt, dass muss man probieren.
MfG
wie von mir beschrieben, kann ich nur bei W2000 testen u. dort geht es. Alles höher entwickelte (XP, 2003..) dürfte ebenfalls unproblematisch sein.. Bei W98 hängt es von der Office-Version ab. Alles was unter Excel2000 ist, könnte es vielleicht problematisch werden. Aber wie gesagt, dass muss man probieren.
MfG
Antwort 4 von kvtv
Hallo Ahnan,
danke für Deine Antwort. Ich werde es am Wochenende Ausprobieren
Gruß Karsten
danke für Deine Antwort. Ich werde es am Wochenende Ausprobieren
Gruß Karsten