Userform sizing problems

[Oggy]

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

 

[Guest]

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