Passing a string to Sub Workbook_Activate using Application.Run

[jwatson34]

First, thanks to mole999 for the help with the first phase of this. I thought I'd be able to use the principles to implement the next phase, but my limited VBA knowledge and research hasn't been enough.

I am trying to have cut, copy, and paste inactive for most users, but if the user enters a password, it will allow cut, copy, paste ("admin" level access, if you will). I was able to find the code to disable cut, copy, paste, and mole999 helped me with referencing a cell value to disable the code (i.e. if A1="X" then exit sub).

What I am trying to do is allow users with the proper password disable the code (X in a cell isn't quite practical) so that they can cut, copy, and paste.

I thought I could use Application.Run to pass the password string to the subs and then use If/Then within the sub to disable the sub when the password is correct. When I try various methods I get a Run-Time error '1004': Application defined or object-defined error.

Any help is greatly appreciated!

Sub GetPassword()Dim strPassword As String


strPassword = InputBox(Prompt:="Your password please:", _
Title:="ENTER YOUR PASSWORD", Default:="Your Password here")






Application.Run "Workbook_Activate", strPassword






End Sub




Private Sub Workbook_Activate()




If strPassword = "Password" Then Exit Sub


If strPassword <> "Password" Or _
strPassword = vbNullString Then


End If


Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub


Private Sub Workbook_Deactivate()
If ActiveSheet.Range("A1") = "X" Then Exit Sub
'This looks for a case sensitive X in cell A1 on the live sheet, exit sub stops the follow on rules that would disable Cut / Copy


If UCase(ActiveSheet.Range("A1")) = "X" Then Exit Sub
'This allows for x or X to be inputted


Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub

 

[DanteAmor]

Only put the parameter in the sub:

Private Sub Workbook_Activate([COLOR=#0000ff]strPassword[/COLOR])

 

[jwatson34]

DanteAmor-

Thanks for the advice. I tried that and I get:

"Compile error:

Procedure declaration does not match description of event or procedure having the same name."

 

[DanteAmor]

Is the macro on other book?
Could you put all your code.

 

[jwatson34]

The macro is all in the same book. The subs that use

If ActiveSheet.Range("A1") = "X" Then Exit Sub

work like I want them to- except I want to refer to a password and not a range on the active sheet.


Here is the entire code:

Sub GetPassword()Dim strPassword As String


strPassword = InputBox(Prompt:="Your password please:", _
Title:="ENTER YOUR PASSWORD", Default:="Your Password here")


Application.Run "Workbook_Activate", strPassword


End Sub



Private Sub Workbook_Activate(strPassword)


If strPassword = "Password" Then Exit Sub


If strPassword <> "Password" Or _
strPassword = vbNullString Then


End If


Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub


Private Sub Workbook_Deactivate()
If ActiveSheet.Range("A1") = "X" Then Exit Sub
'This looks for a case sensitive X in cell A1 on the live sheet, exit sub stops the follow on rules that would disable Cut / Copy


If UCase(ActiveSheet.Range("A1")) = "X" Then Exit Sub
'This allows for x or X to be inputted


Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub


Private Sub Workbook_WindowActivate(ByVal Wn As Window)


If ActiveSheet.Range("A1") = "X" Then Exit Sub
'This looks for a case sensitive X in cell A1 on the live sheet, exit sub stops the follow on rules that would disable Cut / Copy


If UCase(ActiveSheet.Range("A1")) = "X" Then Exit Sub
'This allows for x or X to be inputted


Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub


Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)


If ActiveSheet.Range("A1") = "X" Then Exit Sub
'This looks for a case sensitive X in cell A1 on the live sheet, exit sub stops the follow on rules that would disable Cut / Copy


If UCase(ActiveSheet.Range("A1")) = "X" Then Exit Sub
'This allows for x or X to be inputted


Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)


If ActiveSheet.Range("A1") = "X" Then Exit Sub
'This looks for a case sensitive X in cell A1 on the live sheet, exit sub stops the follow on rules that would disable Cut / Copy


If UCase(ActiveSheet.Range("A1")) = "X" Then Exit Sub
'This allows for x or X to be inputted


Application.CutCopyMode = False
End Sub

 

[RoryA]

I suggest you use a defined name to store the password (perhaps using a prompt at workbook open)

 

[DanteAmor]

The following is a Sub or is it in the events of your book?

[COLOR=#333333]Private Sub Workbook_WindowActivate(ByVal Wn As Window)[/COLOR]

 

[jwatson34]

Thank you both for your ideas, they were a big help. All I needed to do was set a global function. Here's the code that does what I need it to:

In a separate module:

Option ExplicitGlobal Const GlobalPassword As String = "Password"

Then:

Public strPassword As String

Sub GetPassword()


strPassword = InputBox(Prompt:="Your password please:", _
Title:="ENTER YOUR PASSWORD", Default:="Your Password here")


End Sub
Private Sub Workbook_Activate()


If strPassword = GlobalPassword Then Exit Sub


Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub


Private Sub Workbook_Deactivate()


If strPassword = GlobalPassword Then Exit Sub


Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub


Private Sub Workbook_WindowActivate(ByVal Wn As Window)


If strPassword = GlobalPassword Then Exit Sub


Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub


Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)


If strPassword = GlobalPassword Then Exit Sub


Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)


If strPassword = GlobalPassword Then Exit Sub


Application.CutCopyMode = False
End Sub