Change zoom to fit different resolutions

J

jweasl

I would like a macro that I would assign to a button, so that when they click
it, it automatically zooms the page to fit their screen (the pages do not
scroll, they all have frozen panes, because it is only the main window that
is used). I would actually have to make this work across many different
pages, but if someone can get me started I can take it from there.
Thanks!
 
J

Jim Thomlinson

Here is an API to give you the Screen Resolution. Place this in a regular
module. This should be a start anyway.

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
'*****************************************************************
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
 
J

Jim Thomlinson

I am still giving you the credit... You found it... And heck if it ever stops
working I intend to ask you what happened. ;-)
 
J

jweasl

Awesome, thanks. It worked out great!

Jim Thomlinson said:
Here is an API to give you the Screen Resolution. Place this in a regular
module. This should be a start anyway.

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
'*****************************************************************
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top