Restrict User View of Data
Routines to restrict how much of a workbook a user can see
The following routines provide a method for restricting now much of a worksheet a user is able to see and optionally restricts a user to entering data in cells that are not locked. The ZoomToRange routine is an enhancement of a routine by Chip Pearson. These routines were originally put together to provide a calculator for a financial service company where the calculation rules were defined on several worksheets and then summarised on a final summary sheet. It was required to allow the user to select products from dropdowns, to input figures as required and display results based on the calculation rules. In general the user was not allowed to adjust any of the calculation or even see what was happening behind the scenes. There were a few cases where the user could override an interest rate but in general the process was set up so that a ‘customer advisor’ adhered strictly to the defined calculations.
Declare Function GetSystemMetrics32 Lib "user32" Alias
"GetSystemMetrics" (ByVal
nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Sub ChangeView(ByRef strVName
As String)
' Limits users view to
defined view
Dim intVidWidth
As Integer 'Video width
Dim strCVName
As String 'Current View
Name
Dim strCVAddr
As String 'Current View
Address
Dim strCVSName
As String 'Current View
Sheet Name
' Turn off screen
updating while we switch views
Application.ScreenUpdating
= False
' Derive variables for
view name, sheet name and view range address
' from
parameter input to this routine
strCVName = strVName
strCVSName = Range(strCVName).Worksheet.Name
Sheets(strCVSName).Activate
strCVAddr = Range(strCVName).Address
' Turn off restrictions
on cell movement
ActiveSheet.EnableSelection
= xlNoRestrictions
' Zoom
the range to set the top left corner in view
' Preserve rows parameter
is set to False to allow vertical scrolling and
' set
to true to allow horizontal scrolling
ZoomToRange
ZoomThisRange:=Range(strCVAddr), PreserveRows:=False
' Get VidWidth
and zoom accordingly
intVidWidth = GetSystemMetrics32(SM_CXSCREEN)
Select Case intVidWidth
Case Is = 800
ActiveWindow.Zoom = 100
Case Is = 1024
ActiveWindow.Zoom = 100
' Case Is = 1152
' ActiveWindow.Zoom = 90
Case Else
ActiveWindow.Zoom = 100
End Select
' Restrict movement to
locked cells in view range
Sheets(strCVSName).EnableSelection = xlUnlockedCells
' Turn on screen updating
when we have switched views
Application.ScreenUpdating
= True
End Sub
Sub ZoomToRange(ByVal ZoomThisRange
As Range, ByVal PreserveRows
As Boolean)
Dim Wind As Window
' Set ACtive
window
Set Wind = ActiveWindow
' Allow scrolling to
occur by unsetting scroll area
ActiveSheet.ScrollArea
= ""
' Put the upper left cell
of the range in the top-left of the screen.
Application.GoTo
ZoomThisRange(1, 1), True
With ZoomThisRange
If PreserveRows = True Then
.Resize(.Rows.Count, 1).Select
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = False
Else
.Resize(1, .Columns.Count).Select
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = True
End If
End With
' Zoom range
With Wind
.Zoom = True
.VisibleRange(1,
1).Select
End With
' Restrict scrolling to
defined range
ActiveSheet.ScrollArea
= ZoomThisRange.Address
End Sub