Excel Auto Zoom Module

[thetoppy]

I have an excel application that is used by different machines within
my business. It comprises of three different wordbooks that I am
loading as a workspace.
Some of the computers have different screen resolution settings and
some have the same resolutions but different size displays.

I have tried to create a module that looks at the screen resolution
and
then the user name to determine the correct zoom size for each
worksheet.

The code I have works fine when used alone but when I copy the module
to each workbook and try to load the workspace I get a run time 1004
error at:

Sh.select

'method 'select of object '_ worksheet failed '

This is a copy of my code::

Private Declare Function apiGetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nsize As Long) As
Long
Declare Function GetSystemMetrics32 Lib "user32" Alias
"GetSystemMetrics" _
(ByVal nIndex As Long) As Long

Function DisplayVideoResolution() As String
DisplayVideoResolution = GetSystemMetrics32(0) & " x " & _
GetSystemMetrics32(1)
End Function
Function fOSUserName() As String
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function

Sub auto_open()
Dim strResolution As String
Dim zoomnumber As Integer
Dim sh As Worksheet
strResolution = DisplayVideoResolution
If strResolution = "1152 x 864" And fOSUserName = "XXX" Then
zoomnumber = 100
ElseIf strResolution = "1152 x 864" Then
zoomnumber = 95
ElseIf strResolution = "1024 x 768" And fOSUserName = "YYY" Then
zoomnumber = 85
ElseIf strResolution = "1024 x 768" And fOSUserName = "ZZZ" Then
zoomnumber = 88
ElseIf strResolution = "640 x 480" Then
zoomnumber = 50
End If
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
sh.Select
ActiveWindow.Zoom = zoomnumber
Next
ThisWorkbook.Worksheets(1).Select
Application.ScreenUpdating = True

End Sub

I need to know what is wrong with the code. Can anyone please help.
Thank you

 

[Greg Wilson]

I believe this can be used in place of all that complex code. This won't
likely help the workspace related selection problem though.

Assumed is that A1:M32 is the appropriate range such that if the zoom is
adjusted so that this range fits the screen on "Sheet1" then the zoom is
correct for all worksheets in the particular workbook. Change the range
reference and ws name to suit:-

Sub FitToScreen()
Dim r As Range
Dim ws As Worksheet
Dim z As Integer

Application.ScreenUpdating = False
Set ws = Sheets("Sheet1")
ws.Activate
Set r = Selection 'record existing selection
ws.Range("A1:M32").Select
With ActiveWindow
.Zoom = True
z = .Zoom
r.Select 'reselect prior selection
For Each ws In ThisWorkbook.Worksheets
ws.Activate
.Zoom = z
Next
End With
Application.ScreenUpdating = True
End Sub

Regards,
Greg

 

[thetoppy]

Greg, Thank you for your reply,

I need the code to fix zoom levels for different users that access the
file over the network. The reason I have made the code user specific is
because different users have the same resolution but different monitors
and the worksheet doesn’t fit on the screen. I know that the code works
when I open any of the workbooks individually and the settings are
perfect on all of the computers I have tested it on. I can't understand
why the module works individually on the workbooks but when I open the
workspace with all three workbooks in it, I get problems. I’m not too
strong on my coding but I cannot see a reason for this to happen. Is
there defect within my coding that will cause a problem when multiple
workbooks are open as a workspace?

Thank you so much for you assistance..

 

[Greg Wilson]

Just a guess that the Autpen routine doesn't suspend opening of the other
wbs and so is still executing when the other wbs are being opened (and have
the focus) causing an error. Autpen is outdated but still supported and
may not be compatible with workspaces. Try moving it to the ThisWorkbook
module and change the name to "Workbook_Open()" instead.

I confess that I don't use workspaces and I can't test out your situation,
but I thought the code I gave you would work for all computers irrespective
of screen size and resolution since (as I understand) it adjusts the window
zoom for the particular computer so that the selected cell range fits the
screen. I could be dead wrong on this I admit. Suggest you check it out.

Regards,
Greg

 

[Greg Wilson]

I also get the impression on very brief experimentation that workbook_open or
auto_open changes are supplanted by the saved workspace settings. So you
might have to change the zoom for the worksheets after opening the workspace
??? Again, I have no experience with workspaces.

Greg

 

[thetoppy]

Thank you for your help.

i tryed the code that you gave me with little success. Is there any
problem that you can see in the code that i have used that would cause
an error??

 

[Greg Wilson]

Try:

For Each sh In ThisWorkbook.Worksheets
sh.Activate 'Select
ActiveWindow.Zoom = zoomnumber
Next

Regards,
Greg

 

[thetoppy]

Thank you Greg,

It works perfectly, Thank you so much for your help.