I have a computer that can manually be switched to 2 monitors. Both monitors do not have the same screen resolution. I am running a macro controlled presentation in Excel 2010 and I want to change the screen resolution when switching to the other monitor. In a previous post, “Change Screen Resolution using VB”, I found the following solution:
I pasted the code to a module from a workbook but this does not function. Does anybody know what I am doing wrong an how to achieve my goal: Changing screen resolution in Excel by VBA?
Code:
'************************************************* **************** ' DECLARATIONS SECTION '************************************************* **************** Option Compare Database Option Explicit Type RECT x1 As Long y1 As Long x2 As Long y2 As Long End Type ' NOTE: The following declare statements are case sensitive. Declare Function GetDesktopWindow Lib "User32" () As Long Declare Function GetWindowRect Lib "User32" _ (ByVal hWnd As Long, rectangle As RECT) As Long '================================================= ===== 'This code shows how to change the screen resolution. 'Call the function like this: ' ChangeResolution 640, 480 'This would change the screen resolution to 640 pixels x 480 pixels. Note that 'you can only change the resolution to values supported by the display. 'Paste the following code into a module:' Private Declare Function ChangeDisplaySettings Lib "User32" Alias _ "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long Private Declare Function EnumDisplaySettings Lib "User32" Alias _ "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As _ Long, lpDevMode As Any) As Boolean Const DM_PELSWIDTH = &H80000 Const DM_PELSHEIGHT = &H100000 Const CCFORMNAME = 32 Const CCDEVICENAME = 32 Private 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 Public Function Change_Resolution(iWidth As Single, iHeight As Single) Dim DevM As DEVMODE Dim a As Boolean Dim i As Long Dim b As Long i = 0 'Enumerate settings Do a = EnumDisplaySettings(0&, i&, DevM) i = i + 1 Loop Until (a = False) 'Change settings DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT DevM.dmPelsWidth = iWidth DevM.dmPelsHeight = iHeight b = ChangeDisplaySettings(DevM, 0) End Function '************************************************* **************** ' FUNCTION: GetScreenResolution() ' ' PURPOSE: ' To determine the current screen size or resolution. ' ' RETURN: ' The current screen resolution. Typically one of the following: ' 640 x 480 ' 800 x 600 ' 1024 x 768 ' '************************************************* **************** Function GetScreenResolution() As String Dim R As RECT Dim hWnd As Long Dim RetVal As Long hWnd = GetDesktopWindow() RetVal = GetWindowRect(hWnd, R) GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1) End Function
Comment