Solved

Excel VBA - Query for Screen Resolution of a Laptop

Posted on 2013-02-02
3
616 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
3 Comments
 
LVL 10

Accepted Solution

by:
broro183 earned 125 total points
Comment Utility
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 125 total points
Comment Utility
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
Comment Utility
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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This very simple solution applies to a narrow cross-section of the "needs to close" variety. In this case, the full message in Event Viewer was in applog, Event ID 1000: Faulting application iexplore.exe, version 8.0.6001.18702, faulting module …
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

772 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now