Your welcome.

Orlando Magalhães Filho

"Jeff Smith" escreveu na mensagem
...
Thankyou very much for this quick (and no doubt effective solution &
reply).
I will add this. Many thanks.

"Orlando Magalhães Filho" wrote in message
...
Hi Jeff,

Try this:
- Open your workbook;
- Press Alt+F11 to open VBE windows;
- Go Insert menu Module command;
- Insert the code below;
- Press F5 and run the macro AdjustZoom

Public Const vStr As Long = 255
Public Const REG_BINARY = 3&
Public Const REG_DWORD = 4&
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByVal lpData As String, _
ByRef lpcbData As Long) As Long ' Note that if you declare
'the lpData parameter as String, you must pass it By Value.
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As
Long
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002


'Get Registry Value, Arguments:
'1 - Reg Key (Ex.: HKEY_LOCAL_MACHINE),
'2 - Reg SubKey (Ex.: "Software\Microsoft\Windows\CurrentVersion"),
'3 - Name of Value (Ex.:"ProgramFilesDir" or "" for default)
Function GetRegValue(Key As Long, SubKey As String, _
ValueName As String) As String
Dim RetStr As String * vStr 'Fixed-length strings
Dim fctRet As Long
Dim OpenKeyHdl As Long
Dim vType As Long
Dim vLen As Long
Dim i As Integer

GetRegValue = "Error"
vLen = vStr
fctRet = RegOpenKey(Key, SubKey, OpenKeyHdl)
If fctRet < 0 Then Exit Function

fctRet = RegQueryValueEx(OpenKeyHdl, ValueName, 0&, vType, RetStr,
vLen)
RegCloseKey OpenKeyHdl
If fctRet < 0 Then Exit Function

If vType = REG_BINARY Then
GetRegValue = ""
For i = 1 To vLen
GetRegValue = GetRegValue _
& IIf(Len(Hex(Asc(Mid(RetStr, i, 1)))) = 1, "0", "") _
& Hex(Asc(Mid(RetStr, i, 1))) & " "
Next
Exit Function
End If

If vType = REG_DWORD Then
GetRegValue = "0x"
For i = 4 To 1 Step -1
GetRegValue = GetRegValue _
& IIf(Len(Hex(Asc(Mid(RetStr, i, 1)))) = 1, "0", "") _
& Hex(Asc(Mid(RetStr, i, 1)))
Next
Exit Function
End If

GetRegValue = Left(RetStr, vLen - 1)
End Function

Public Sub AdjustZoom()
Dim Res As String
Res =
Application.WorksheetFunction.Clean(GetRegValue(HK EY_LOCAL_MACHINE,
_
"Config\0001\Display\Settings", "Resolution"))
Select Case Res
Case "640,480"
ActiveWindow.Zoom = 60
Case "800,600"
ActiveWindow.Zoom = 80
Case "1024,768"
ActiveWindow.Zoom = 100
End Select
End Sub



HTH

---
Orlando Magalhães Filho

(So that you get best and rapid solution and all may benefit from the
discussion, please reply within the newsgroup, not in email)



"Jeff Smith" escreveu na mensagem
...
Hi,
Two colleagues and I work on one "master" spreadsheet with all of our
company products listing. Only one person at a tiime uses it.
I prefer high screen resolution 1024 x 768 whereas my colleagues
prefer
the
800 x 600?.

My spreadsheet is designed to fit the whole screen and rather than
leaving
different zoom settings, I wonder if it is possible for a macro for a
VBA
routine to detect the screen resolution and automatically select the
appropriate zoom (can define). Any assistance here would be greatly
appreciated.

Thanks in anticipation of any kind help.

Jeff Smith