Force users to enable macros on a protected workbook?

  • Thread starter Thread starter Lostguy
  • Start date Start date
L

Lostguy

Hello!

I found this code for ensuring that users always enable macros, but I
have a few questions about it:

http://www.vbaexpress.com/kb/getarticle.php?kb_id=379

a) What would needed to be added to the code to make it work on a
protected workbook?

b) Does the code need some kind of error handling?

(For my workbooks, there is a "Print" button on each sheet that when
you push it, autofits the rows, pops up the spell checker, compares a
few cells to make sure there are no duplicates, end dates don't come
before start dates, etc.

So without macros being always enabled, the workbook's functionality
goes way down. So, I want to hide the sheets if the user doesn't
enable macros.)

Thanks for the help!

VR/Lost
 
Something like this perhaps. Create a splash sheet that displays a message
to the user that he must close the file and reopen it with macros enabled.
Then in a BeforeClose event macro, hide all the sheets except the splash
sheet. Then in a Workbook_Open event macro, hide the splash sheet and
select whatever sheet you want to be the active sheet. This way the user
will see what you want him to work with only if he opens the wb with macros
enabled. Otherwise he gets the splash sheet and no more. HTH Otto
 
I actually do very much exactly what you've described from time to time.
My 'splash' sheet contains the instructions for setting Macro Security Level
as an assist to the novice Excel user who may have security level set to
High or Very High or equivalent.
 
Hello!

I think I pieced together code that would work for a protected
workbook. So, this disables all the cut-and-pastes, disables the
toolbar print and puts the print from macro button, and hides the
sheets if the user does not enable macros.

Does anyone see anything to make this code better?

VR/Lost


Private Const dsWarningSheet As String = "Splash"
Private Sub Workbook_Activate(): Application.CutCopyMode = False:
Application.OnKey "^c", "": Application.CellDragAndDrop = False: End
Sub
Private Sub Workbook_Deactivate(): Application.CellDragAndDrop = True:
Application.OnKey "^c": Application.CutCopyMode = False: End Sub
Private Sub Workbook_WindowActivate(ByVal Wn As Window):
Application.CutCopyMode = False: Application.OnKey "^c", "":
Application.CellDragAndDrop = False: End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window):
Application.CellDragAndDrop = True: Application.OnKey "^c":
Application.CutCopyMode = False: End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal
Target As Range, Cancel As Boolean): Cancel = True: MsgBox "Right
click menu deactivated." & vbCrLf & "Cannot copy or ''drag & drop''.",
16, "For this workbook:": End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object):
Application.OnKey "^c", "": Application.CellDragAndDrop = False:
Application.CutCopyMode = False: End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object):
Application.CutCopyMode = False: End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If PrtOK Then
Cancel = False
Else
MsgBox "Please use the green Print button."
Cancel = True
End If
End Sub

Private Sub Workbook_Beforesave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="password"
For Each ds In ActiveWorkbook.Sheets
If LCase(dsWarningSheet) = LCase(ds.Name) Then
ds.Visible = True
Else: ds.Visible = xlVeryHidden
End If
Next
ActiveWorkbook.Protect Password:="password"
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal ds As Object, ByVal
Target As Excel.Range)
Application.CutCopyMode = False
Application.ScreenUpdating = False
If LCase(ds.Name) = LCase(dsWarningSheet) Then
For Each ds In ActiveWorkbook.Sheets
ds.Visible = True
Next
ActiveSheet.Visible = xlVeryHidden
End If
Application.ScreenUpdating = False
End Sub

Private Sub workbook_open()
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="password"
Sheets(dsWarningSheet).Select
For Each ds In ActiveWorkbook.Sheets
ds.Visible = True
Next
ActiveWorkbook.Protect Password:="password"
Application.ScreenUpdating = True
End Sub
 
I have a kind of similar question about this code: I have entered this code in my entry file and want to use a master file to pump data X in the entry file, save as ..X, close, the pump data Y in the entry file, save as ..Y, close etc. etc. Now without this code everything goes fine and my master file creates the 60 files I need. Yet with this code the data is being pumped in the file but the file is not saved... Does anyone have any idea what to do or what the cause is. I would really appreciate your help!
 
Lostguy said:
Hello!

I think I pieced together code that would work for a protected
workbook. So, this disables all the cut-and-pastes, disables the
toolbar print and puts the print from macro button, and hides the
sheets if the user does not enable macros.

Does anyone see anything to make this code better?

VR/Lost


Private Const dsWarningSheet As String = "Splash"
Private Sub Workbook_Activate(): Application.CutCopyMode = False:
Application.OnKey "^c", "": Application.CellDragAndDrop = False: End
Sub
Private Sub Workbook_Deactivate(): Application.CellDragAndDrop = True:
Application.OnKey "^c": Application.CutCopyMode = False: End Sub
Private Sub Workbook_WindowActivate(ByVal Wn As Window):
Application.CutCopyMode = False: Application.OnKey "^c", "":
Application.CellDragAndDrop = False: End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window):
Application.CellDragAndDrop = True: Application.OnKey "^c":
Application.CutCopyMode = False: End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal
Target As Range, Cancel As Boolean): Cancel = True: MsgBox "Right
click menu deactivated." & vbCrLf & "Cannot copy or ''drag & drop''.",
16, "For this workbook:": End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object):
Application.OnKey "^c", "": Application.CellDragAndDrop = False:
Application.CutCopyMode = False: End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object):
Application.CutCopyMode = False: End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If PrtOK Then
Cancel = False
Else
MsgBox "Please use the green Print button."
Cancel = True
End If
End Sub

Private Sub Workbook_Beforesave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="password"
For Each ds In ActiveWorkbook.Sheets
If LCase(dsWarningSheet) = LCase(ds.Name) Then
ds.Visible = True
Else: ds.Visible = xlVeryHidden
End If
Next
ActiveWorkbook.Protect Password:="password"
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal ds As Object, ByVal
Target As Excel.Range)
Application.CutCopyMode = False
Application.ScreenUpdating = False
If LCase(ds.Name) = LCase(dsWarningSheet) Then
For Each ds In ActiveWorkbook.Sheets
ds.Visible = True
Next
ActiveSheet.Visible = xlVeryHidden
End If
Application.ScreenUpdating = False
End Sub

Private Sub workbook_open()
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="password"
Sheets(dsWarningSheet).Select
For Each ds In ActiveWorkbook.Sheets
ds.Visible = True
Next
ActiveWorkbook.Protect Password:="password"
Application.ScreenUpdating = True
End Sub
Click to expand...
If you email the workbook from within Excel once it has been opened and macros enabled, does the code still work for the recipient of the mail?
 
Hello!

I think I pieced together code that would work for a protected
workbook. So, this disables all the cut-and-pastes, disables the
toolbar print and puts the print from macro button, and hides the
sheets if the user does not enable macros.

Does anyone see anything to make this code better?

VR/Lost


Private Const dsWarningSheet As String = "Splash"
Private Sub Workbook_Activate(): Application.CutCopyMode = False:
Application.OnKey "^c", "": Application.CellDragAndDrop = False: End
Sub
Private Sub Workbook_Deactivate(): Application.CellDragAndDrop = True:
Application.OnKey "^c": Application.CutCopyMode = False: End Sub
Private Sub Workbook_WindowActivate(ByVal Wn As Window):
Application.CutCopyMode = False: Application.OnKey "^c", "":
Application.CellDragAndDrop = False: End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window):
Application.CellDragAndDrop = True: Application.OnKey "^c":
Application.CutCopyMode = False: End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal
Target As Range, Cancel As Boolean): Cancel = True: MsgBox "Right
click menu deactivated." & vbCrLf & "Cannot copy or ''drag & drop''.",
16, "For this workbook:": End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object):
Application.OnKey "^c", "": Application.CellDragAndDrop = False:
Application.CutCopyMode = False: End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object):
Application.CutCopyMode = False: End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If PrtOK Then
Cancel = False
Else
MsgBox "Please use the green Print button."
Cancel = True
End If
End Sub

Private Sub Workbook_Beforesave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="password"
For Each ds In ActiveWorkbook.Sheets
If LCase(dsWarningSheet) = LCase(ds.Name) Then
ds.Visible = True
Else: ds.Visible = xlVeryHidden
End If
Next
ActiveWorkbook.Protect Password:="password"
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal ds As Object, ByVal
Target As Excel.Range)
Application.CutCopyMode = False
Application.ScreenUpdating = False
If LCase(ds.Name) = LCase(dsWarningSheet) Then
For Each ds In ActiveWorkbook.Sheets
ds.Visible = True
Next
ActiveSheet.Visible = xlVeryHidden
End If
Application.ScreenUpdating = False
End Sub

Private Sub workbook_open()
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="password"
Sheets(dsWarningSheet).Select
For Each ds In ActiveWorkbook.Sheets
ds.Visible = True
Next
ActiveWorkbook.Protect Password:="password"
Application.ScreenUpdating = True
End Sub
Click to expand...

If you email the workbook from within Excel once it has been opened and macros enabled, does the code still work for the recipient of the mail?
 
Back
Top