PDA

View Full Version : CANNOT MADE CODE WORK



bensonjr
09-17-2009, 09:00 AM
I was given the code below but I cannot make it work. Even I placed an x in the A1 cell of blankSheet, I can go to another sheet and make a minor change before blanksheet is again activated. I am using this as a form of protection for intruders. What am I missing? Do you know another way to keep people off a workbook w/o the use of a password? Could someone please help me with this? Thank you very much . . .


Normal module


Sub GoToBlankSheet()
ThisWorkbook.Sheets("blankSheet").Activate
End Sub



and this in ThisWorkbook


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim keyCell As Range, testFor As String
Set keyCell = Sh.Range("A1"): Rem adjust
testFor = "x": Rem adjust

Select Case Sh.Name
Case Is = "blankSheet"
Rem do nothing
Case Else
If UCase(keyCell.Text) = UCase(testFor) Then
Call stopTime
End If
End Select
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Call stopTime
If Sh.Name = "blankSheet" Then
Call setTime
End If
End Sub

Sub setTime()
RunTime = Now + TimeValue("00:00:04"): Rem adjust delay
Application.OnTime RunTime, "GoToBlankSheet"
End Sub

Sub stopTime()
On Error Resume Next
Application.OnTime RunTime, "GoToBlankSheet", schedule:=False
On Error GoTo 0
End Sub

stanleydgrom
09-17-2009, 11:45 AM
bensonjr,

Try creating a worksheet with the name blankSheet

bensonjr
09-17-2009, 10:34 PM
I did and still nothing. Thank you for you input . . .

bensonjr
09-17-2009, 10:38 PM
I have Excel 2003 SP3. Would that matter? Thanks for your help . . .

mdmackillop
09-18-2009, 04:19 AM
Can you explain the logic of workbook use and what you are trying to protect.
What is wrong with passwords?

bensonjr
09-18-2009, 09:15 AM
I probably made it sound more complicated than it really is. So please let me try again:

I need two things: 1) When somebody tries to open my workbook DreamLand, the visitor will be forced to enable macros to keep on going and 2) if he does not don’t place an x in A1 of worksheet Customs (opening worksheet) within 4 seconds, he’ll be taking to worksheet Immigration. The intruder may try clicking on other visible worksheet tabs and take a pick, but again within 4 seconds he will go back to the Immigration “holding tank” if he does not place the x where it belongs.

There’s nothing wrong with passwords, they just aren’t as fun as what I’m trying. Isn’t it? And there’s still more in store to come you’ll see.

Thank you very much for your interest and help hoping my question is clearer now.

bensonjr
09-18-2009, 09:17 AM
CORRECTION

I probably made it sound more complicated than it really is. So please let me try again:

I need two things: 1) When somebody tries to open my workbook DreamLand, the visitor will be forced to enable macros to keep on going and 2) if he does not don’t place an x in A1 of worksheet Customs (opening worksheet) within 4 seconds, he’ll be taken to worksheet Immigration. The intruder may try clicking on other visible worksheet tabs and take a pick, but again within 4 seconds he will go back to the Immigration “holding tank” if he does not place the x where it belongs.

There’s nothing wrong with passwords, they just aren’t as fun as what I’m trying. Isn’t it? And there’s still more in store to come you’ll see.

Thank you very much for your interest and help hoping my question is clearer now.

mdmackillop
09-19-2009, 01:37 AM
I recall some KB items for enforcing macros, but for your own code, try this


'Standard module
Sub GoToBlankSheet()
If Not UCase(Sheets("Customs").Range("A1")) = "X" Then
ThisWorkbook.Sheets("Immigration").Activate
End If
End Sub

'Workbook Module
Option Explicit

Dim RunTime

Private Sub Workbook_Open()
Sheets("Customs").Range("A1").ClearContents
Sheets("Customs").Activate
SetTime
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim keyCell As Range, testFor As String
Set keyCell = Sheets("Customs").Range("A1"): Rem adjust
testFor = "x": Rem adjust

Select Case Sh.Name
Case Is = "Immigration"
Rem Do Nothing
Case Else
If UCase(keyCell.Text) = UCase(testFor) Then
Call StopTime
End If
End Select
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

If Sh.Name = "Immigration" Then
Call SetTime
Else
Call StopTime
End If
End Sub

Sub SetTime()
RunTime = Now + TimeValue("00:00:04"): Rem adjust delay
Application.OnTime RunTime, "GoToBlankSheet"
End Sub

Sub StopTime()
On Error Resume Next
Application.OnTime RunTime, "GoToBlankSheet", schedule:=False
On Error GoTo 0
End Sub

bensonjr
09-20-2009, 04:59 PM
It took me a little bit to figure it out, but your solution works great. Thank you, so very much Doctor.

bensonjr
09-20-2009, 05:06 PM
I recall some KB items for enforcing macros, but for your own code, try this


'Standard module
Sub GoToBlankSheet()
If Not UCase(Sheets("Customs").Range("A1")) = "X" Then
ThisWorkbook.Sheets("Immigration").Activate
End If
End Sub

'Workbook Module
Option Explicit

Dim RunTime

Private Sub Workbook_Open()
Sheets("Customs").Range("A1").ClearContents
Sheets("Customs").Activate
SetTime
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim keyCell As Range, testFor As String
Set keyCell = Sheets("Customs").Range("A1"): Rem adjust
testFor = "x": Rem adjust

Select Case Sh.Name
Case Is = "Immigration"
Rem Do Nothing
Case Else
If UCase(keyCell.Text) = UCase(testFor) Then
Call StopTime
End If
End Select
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

If Sh.Name = "Immigration" Then
Call SetTime
Else
Call StopTime
End If
End Sub

Sub SetTime()
RunTime = Now + TimeValue("00:00:04"): Rem adjust delay
Application.OnTime RunTime, "GoToBlankSheet"
End Sub

Sub StopTime()
On Error Resume Next
Application.OnTime RunTime, "GoToBlankSheet", schedule:=False
On Error GoTo 0
End Sub

One more quick thing though. How do I have access to the prompt sheet to modify it? and could I make it work in conjunction with the other question of mine, regarding the x to gain access?