Excel screen resolution query
 

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

Excel screen resolution query
 

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

Excel screen resolution query
 

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

Excel screen resolution query
 

Hi Jeff

A slightly different approach: This fills the/an Excel window with columns A:K no matter
which screen resolution used, no matter if the window is maximized or not:

Sub Test()
Columns("A:K").Select
ActiveWindow.Zoom = True
Range("A1").Select
End Sub

--
HTH. Best wishes Harald
Excel MVP

Followup to newsgroup only please.

"Jeff Smith" wrote in message ...
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

Excel screen resolution query
 

Hi, I have inserted this macro into a module and run the macro "adjust
zoom".
The maco "hangs up" on this statement:

Application.WorksheetFunction.Clean(GetRegValue(HK EY_LOCAL_MACHINE, _
"Config\0001\Display\Settings", "Resolution"))

I'm wondering if I should have placed all the code above the macro proper
(declarations etc) somewhere else? Auto_open macro or something?

If you can see where I've gone wrong.....

sincerely

Jeff Smith



"Jeff Smith" wrote in message
...
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

Excel screen resolution query
 

Harald,
Thank you for this. I can see many applications for this small macro. I
have added it to the macros and it works fine.

I am very impressed with all the expert users who take the time to share
their experience and knowledge with others less skilled. Thank you.

sincerely

Jeff Smith

"Harald Staff" wrote in message
...
Hi Jeff

A slightly different approach: This fills the/an Excel window with columns
A:K no matter
which screen resolution used, no matter if the window is maximized or not:

Sub Test()
Columns("A:K").Select
ActiveWindow.Zoom = True
Range("A1").Select
End Sub

--
HTH. Best wishes Harald
Excel MVP

Followup to newsgroup only please.

"Jeff Smith" wrote in message
...
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

Excel screen resolution query
 

"Jeff Smith" wrote in message ...
Harald,
Thank you for this. I can see many applications for this small macro. I
have added it to the macros and it works fine.

Hi Jeff. you're welcome

I am very impressed with all the expert users who take the time to share
their experience and knowledge with others less skilled. Thank you.

This is a phenomenon that I talk about for hours whenever I get the chance. One thing is
"peace, love and everything for free" which works perfect here. Another thing is that
I/you as a person learn tons of stuff being here. And there's the communist idea "provide
what you can, receive what you need" thing. But the capitalist logic is fullfilled too;
There are times where I'm totally stuck on a database problem or similar. I ask someone in
a newsgroup like this or find something on a free website which solves my problem, and pay
back with a couple of hours of spreadsheet solutions. Everyone wins, I love it and,
luckily, so does my boss.

Best wishes Harald
Excel MVP

Followup to newsgroup only please.