PDA

View Full Version : Solved: Auto Size / Center View Screen



Rlb53
02-19-2012, 01:05 PM
Good Morning, Afternoon , Evening (as the case may be?)

The "Auto-Open" Macro of my workbook provides for a selected area to view on the Main Sheet.

Application.DisplayFullScreen = True
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False

' scroll_stop Macro
Sheets("Main").Select
ActiveSheet.ScrollArea = "a1: u28"
ActiveSheet.Protect

Is there a command that will automatically adjust the zoom according to the Monitor settings so that the selected area is centered on the screen?

As I open the workbook on different computer systems I find that the screen settings alter the view.

I have a code generated that will call for and assist the user to Zoom the screen settings upon activation of the workbook, (not shown) but if it could be done for them without interaction, it would be more appealing.

----------
I would also like to deactivate the "Restore Down" and "Close" buttons at the top right of the screen. I require that they use the "EXIT" command button on the workbook sheet to perform processes prior to being closed.


Thank you for your Thoughts.

mdmackillop
02-19-2012, 02:19 PM
'<< CODE FOR THE "ThisWorkbook" MODULE >>

Option Explicit

Private Sub Workbook_Open()

'N.B. a screen resolution of 800x600 pixels was used for this E.G.

'//Obtain current users screen width & height (in pixels)
Dim w As Long, x As Long
Call SetScreen
w = Range("a1:U1").Width
Run ("MonitorInfo")

ActiveWindow.Zoom = Int(ScrWidth / w * 100)

End Sub

Private Sub SetScreen()
Application.DisplayFullScreen = True
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False

' scroll_stop Macro
Sheets("Main").Select
ActiveSheet.ScrollArea = "a1: u28"
ActiveSheet.Protect

End Sub

'<< CODE FOR STANDARD MODULE >>

Option Explicit
Public ScrWidth&, ScrHeight&
Declare Function GetSystemMetrics32 Lib "User32" _
Alias "GetSystemMetrics" (ByVal nIndex&) As Long

Private Sub MonitorInfo()
ScrWidth = GetSystemMetrics32(0) '< in pixels
ScrHeight = GetSystemMetrics32(1)
End Sub

Rlb53
02-19-2012, 05:14 PM
Thank You !

It took me a few minutes to figure out how to adjust the settings but ended up with EXACTLY what I was Looking for !

This is what I ended up with. Option Explicit
Public ScrWidth&, ScrHeight&
Declare Function GetSystemMetrics32 Lib "User32" _
Alias "GetSystemMetrics" (ByVal nIndex&) As Long

Private Sub MonitorInfo()
ScrWidth = GetSystemMetrics32(0) '< in pixels
ScrHeight = GetSystemMetrics32(1)
End Sub

Sub auto_Open()

'N.B. a screen resolution of 800x600 pixels was used for this E.G.
'//Obtain current users screen width & height (in pixels)
Dim w As Long, x As Long
Call SetScreen
' adjusted Range("x:x") to provide correct aspect ratio with information
' presented on screen
w = Range("a1:y1").Width
Run ("MonitorInfo")
ActiveWindow.Zoom = Int(ScrWidth / w * 100)

End Sub

Private Sub SetScreen()
Application.DisplayFullScreen = True
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False

' scroll_stop Macro
Sheets("Main").Select
' adjusted Activesheet.ScrollArea = "x:x" to lock screen so only desired
'view is available
ActiveSheet.ScrollArea = "d1: u31"
ActiveSheet.Protect

End Sub

Everyone here is Awesome!

Would you know how to Disable the "Restore Down" and "Close" buttons in the top right corner of the Screen? I want to force the user to exit with the Command Button on their Screen. There would be followup commands that need to be performed before the Workbook Closes.

Thank you !