VBA to adjust a spreadsheets zoom level based on a users monitor resolution

VBA to adjust a spreadsheets zoom level based on a users monitor resolution

I am currenty tweaking this code to make it so that the excel applications I build for our sales team adjust based on the large variation in monitor sizes. If you want to use this code on your own project please follow these instructions.

Once you have accessed your excel document enter the VBA environment.

Accessing VBA in Excel

Press Alt+F11 from within an opened Excel document

Either 'Insert a Module' by clicking the insert button or 'Right-Click' on a worksheet and select 'View Code'

Copy the code below.

Paste the code into the new module or worksheet code area.

Adjusting the VBA code

If you want to adjust the zoom of all worksheets then comment out (by adding a ' before the line) or remove the following lines

If activews = cmws Then
maxWidth = GetSystemMetrics(0) * 0.5
Else

End If

If you want to target a specific worksheet then change the name of the value between Sheets("enter worksheet name here").Name in the variable cmws

Private Declare PtrSafe Function GetSystemMetrics Lib "USER32" _
(ByVal nIndex As Long) As Long

Sub Zoom()
Dim maxWidth As Long
Dim myWidth As Long
Dim myZoom As Single
Dim cmws As String
Dim activews As String

'Set name of the worksheet you want to adjust zoom on
cmws = Sheets("Customer Matrix").Name
activews = ThisWorkbook.ActiveSheet.Name

If activews = cmws Then 'remove this line if you want
maxWidth = GetSystemMetrics(0) * 0.5 'remove this line if you want
Else 'remove this line if you want
maxWidth = GetSystemMetrics(0) * 0.95
End If 'remove this line if you want
myWidth = ThisWorkbook.ActiveSheet.Range("R1").Left
myZoom = maxWidth / myWidth
ActiveWindow.Zoom = myZoom * 100
End Sub