Without looking too closely at what you are doing here is a script for
finding the screen resolution...
Option Explicit
'************************************************* ****************
' DECLARATIONS SECTION
'************************************************* ****************
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
'************************************************* ****************
' 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
'
' AUTHOR:
' Tom Ogilvy
'
http://support.microsoft.com/?id=148395
'************************************************* ****************
Public 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
Sub test()
MsgBox GetScreenResolution
End Sub
--
HTH...
Jim Thomlinson
"Oggy" wrote:
Hi,
I have the following code to set the userform resoultion the the
screen on different computers. This works fine on my laptop, but on my
home computer it errors on GetSR
Can anyone advise me on a code that will work on all PC'S.
Many thanks
Oggy
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long)
As Long
'---------------------------------
Public Function GetSR() As Variant
' x and y
GetSR = Array(GetSystemMetrics(0), GetSystemMetrics(1))
End Function
'---------------------------------
Sub menu()
' Adjusts userform size to compensate for screen resolution changes.
Dim RatioX As Single
Dim RatioY As Single
Dim ActualX As Long
Dim ActualY As Long
'Screen resolution in development environment.
Const BaseX As Long = 1280
Const BaseY As Long = 800
'Call function to get actual screen resolution
varSize = GetSR
ActualX = varSize(0)
ActualY = varSize(1)
'Determine ratio of actual screen resolution to
'the original or base resolution.
RatioX = ActualX / BaseX
RatioY = ActualY / BaseY
'Adjust userform magnification and size.
UserForm16.Zoom = (100 * ((RatioX + RatioY) / 2))
UserForm16.Width = UserForm16.Width * RatioX
UserForm16.Height = UserForm16.Height * RatioY
UserForm16.Show
Unload UserForm16
Set UserForm16 = Nothing
End Sub