Passing a string to Sub Workbook_Activate using Application.Run

jwatson34

New Member
Joined
Sep 7, 2017
Messages
15
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!

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()




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
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Only put the parameter in the sub:

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

jwatson34

New Member
Joined
Sep 7, 2017
Messages
15
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Is the macro on other book?
Could you put all your code.
 

jwatson34

New Member
Joined
Sep 7, 2017
Messages
15

ADVERTISEMENT

The macro is all in the same book. The subs that use
Code:
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:

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

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
35,503
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
I suggest you use a defined name to store the password (perhaps using a prompt at workbook open)
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
The following is a Sub or is it in the events of your book?

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

jwatson34

New Member
Joined
Sep 7, 2017
Messages
15
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:

Code:
Option ExplicitGlobal Const GlobalPassword As String = "Password"

Then:

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,109,028
Messages
5,526,335
Members
409,696
Latest member
EERS

This Week's Hot Topics

Top