This is a modified code version that should require less tinkering.
It also should be easier to use as you only have to adjust the
BaseX and BaseY values before running the code.
(also change the userform name to the actual name)
There are some explanatory notes included in the code.
Note: The Declare Function GetSystemMetrics code line goes at the
very top of the module just below "Option Explicit"
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
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 ResizeForm_R1()
' Adjusts userform size to compensate for screen resolution changes.
' Jim Cone - San Francisco, USA - Dec 2006
Dim varSize As Variant
Dim RatioX As Single
Dim RatioY As Single
Dim ActualX As Long
Dim ActualY As Long
'Screen resolution in development environment.
'Adjust as necessary.
Const BaseX As Long = 800
Const BaseY As Long = 600
'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.
UserForm1.Zoom = (100 * ((RatioX + RatioY) / 2))
UserForm1.Width = UserForm1.Width * RatioX
UserForm1.Height = UserForm1.Height * RatioY
UserForm1.Show
Unload UserForm1
Set UserForm1 = Nothing
End Sub
--------------
"Minitman" <
[email protected]>
wrote in message
Hey Jim,
Thanks for the reply.
This is beyond my current level of understanding, but I think I can
find out the references to tell me what is going on. It will take me
a couple of days to muddle though it. It looks like what I need at
first glance.
I will give this a shot. Thanks.
-Minitman