?
Solved

Excel VBA - Query for Screen Resolution of a Laptop

Posted on 2013-02-02
3
Medium Priority
?
638 Views
Last Modified: 2013-03-01
Hi,

Is there an Excel  VBA code that I could query the screen resolution of a laptop  ( e.g. 1366 x 768 )  when I fire up a workbook from it ?

Is so, would appreciate your help with the vba code.


Thanks
0
Comment
Question by:Russellbrown
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 10

Accepted Solution

by:
broro183 earned 500 total points
ID: 38846467
hi Russell,

Does this do what you want?

'sourced from http://www.mrexcel.com/forum/excel-questions/61607-checking-changing-screen-resolution-visual-basic-applications.html#post288534
'32-bit API declaration
Declare Function GetSystemMetrics Lib "user32" _
  (ByVal nIndex As Long) As Long

Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1

Sub DisplayVideoInfo()
    vidWidth = GetSystemMetrics(SM_CXSCREEN)
    vidHeight = GetSystemMetrics(SM_CYSCREEN)
    
    If vidWidth = 1024 And vidHeight = 768 Then
        Exit Sub
    Else
        Ans = MsgBox("The Current Video mode is:" & vidWidth & " X " & vidHeight & vbCrLf _
        & "S.T.A.R.S. is designed to be viewed at 1024 X 768" & vbCrLf _
        & "Please goto Start-->Control Panel-->Display-->Settings" & vbCrLf _
        & "and adjust your screen area accordingly." _
        , vbCritical, "Insufficient Video Settings")
    End If

End Sub

Open in new window


This page also shows a line of code to open up the dialogbox to change the resolution.

hth
Rob
0
 
LVL 1

Assisted Solution

by:cben
cben earned 500 total points
ID: 38848355
Hi
I have long used a code, probably based on the Mr Excel one above, to adjust the zoom on the workbook sheets according to the display.
Call it in the
Option Explicit

'32-bit API declaration
Declare Function GetSystemMetrics Lib "user32" _
  (ByVal nIndex As Long) As Long

Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1



Sub SetZoomByVideo()
    Dim vidWidth As Long, vidHeight As Long
    Dim Msg As String
    Dim ZoomVal As Integer
    Dim SheetNames() As String
    Dim SheetHidden() As Boolean
    Dim i As Integer
    Dim SheetCount As Integer
    Dim VisibleWins As Integer
    Dim Item As Object
    Dim OldActive As Object
   
    vidWidth = GetSystemMetrics(SM_CXSCREEN)
    ' Check if not same as previous opening so no change needed.
    If vidWidth = Range("Video") Then GoTo Out
    vidHeight = GetSystemMetrics(SM_CYSCREEN)
    Msg = "The current video mode is: "
    Msg = Msg & vidWidth & " X " & vidHeight
    MsgBox Msg
    
     '   Turn off screen updating
     Application.ScreenUpdating = False
    ' Table to adjust to new screen resolutions
    ' Manual change to fix values
    
    If vidWidth < 799 Then ZoomVal = 65
    If vidWidth >= 800 Then ZoomVal = 75
    If vidWidth >= 1024 Then ZoomVal = 100
    If vidWidth >= 1152 Then ZoomVal = 100
    If vidWidth >= 1279 Then ZoomVal = 120
     If vidWidth >= 1280 Then ZoomVal = 120
     On Error Resume Next
    Sheet4.Unprotect Password:=pw
    

    Range("Video") = vidWidth
    Range("Zoom") = ZoomVal
     Sheet4.Protect Password:=pw, UserInterfaceOnly:=True
On Error GoTo 0
'   Sets zoom of sheets active workbook.
      
        
    If ActiveWorkbook Is Nothing Then Exit Sub ' No active workbook
    SheetCount = ActiveWorkbook.Sheets.Count
   
    
'   Check for protected workbook structure
    If ActiveWorkbook.ProtectStructure Then
        MsgBox ActiveWorkbook.Name & " is protected.", _
           vbCritical, "Cannot Zoom Sheets."
        Exit Sub
    End If

'   Disable Ctrl+Break
    Application.EnableCancelKey = xlDisabled
       
'   Get the number of sheets
    SheetCount = ActiveWorkbook.Sheets.Count
    
'   Redimension the arrays
    ReDim SheetNames(1 To SheetCount)
    ReDim SheetHidden(1 To SheetCount)

'   Store a reference to the active sheet
    Set OldActive = ActiveSheet
   
'   Put sheet names into array
     For i = 1 To SheetCount
        
           SheetNames(i) = ActiveWorkbook.Sheets(i).Name
       
    Next i
   
'   Fill array with hidden status of sheets
    For i = 1 To SheetCount
        SheetHidden(i) = Not ActiveWorkbook.Sheets(i).Visible
'       unhide hidden sheets
        If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = True
    Next i
    'For i = 1 To SheetCount
        'SheetNames(i) = ThisWorkbook.Sheets("ZoomSheet").Cells(i, 1)
    'Next i
   

    
'  Zoom the sheets
    For i = 1 To SheetCount
        Sheets(SheetNames(i)).Activate
        ActiveWindow.Zoom = ZoomVal
    Next i

'   Re-hide sheets
    For i = 1 To SheetCount
        If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = False
    Next i
  '  MsgBox "Zoom Setting has been reset to suit your screen at avalue of " & ZoomVal
    
'   Reactivate the original active sheet
    OldActive.Activate
Out:
    Application.ScreenUpdating = True
End Sub

Open in new window


Range Names in sheet Video & ZoomVal are used to store the previous settings and avoid the routine if same as before. pw is coded in password.

Hope this helps
0
 

Author Comment

by:Russellbrown
ID: 38849839
Hi both,

Thank you for the replies.  

1) obtaining the screen resolution - that is great and is working fine;

2) I will modfiy /  incorporate a code to execute the following:
    if resolution is <=800, then  me.zoom = 75
    if resolution is <=1066, then me.zoom = 85
    if resolution is <=1366, then me.zoom = 100 .........
*  ( since I am using Excel  userforms )


Wll revert with the results.

Many thanks and regards
0

Featured Post

Percona Live Europe 2017 | Sep 25 - 27, 2017

The Percona Live Open Source Database Conference Europe 2017 is the premier event for the diverse and active European open source database community, as well as businesses that develop and use open source database software.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question