Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 650
  • Last Modified:

Excel VBA - Query for Screen Resolution of a Laptop


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.

2 Solutions
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
        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.

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
        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
    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
RussellbrownAuthor Commented:
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

Featured Post

Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now