Hi All,
I am very new to VBA code and I am trying to write code for user / admin protection to allow unprotecting cells or not, I have attached the logic in the form of a flow chart.
I would be very thankful if anyone can help me.
Cheers
Lee
Hi All,
I am very new to VBA code and I am trying to write code for user / admin protection to allow unprotecting cells or not, I have attached the logic in the form of a flow chart.
I would be very thankful if anyone can help me.
Cheers
Lee
Greetings,
You may wish to review http://www.vbaexpress.com/kb/getarticle.php?kb_id=531
as well as a recent thread dealing in a similar area:
http://www.vbaexpress.com/forum/showthread.php?t=22600
As to the workbook's expiration date, there is also at least one really good (a couple I believe) articles in the KB section.
While these probably won't get you "all the way there", I would read, as they'll give ideas as to how to handle.
Happy coding and welcome,
Mark
Thanks very much Mark,
I have looked at the coding from these links.
They work perfectly with a bit of change to suit my design.
Although I do have a program that will unprotect the work sheet no matter what the password is, I am trying to write code to stop people from using this program, the only piece of code that I am struggling with is the part where the ELSE command then delete formulas or KILL all sheets / file.
Thanks for your input.
Cheers
Lee
I have just worked out the code that will replace all formulas in my sheets with the numeric value, which is just as good as deleting the sheet.
I must just try compiling the code for the logic:
Sub test()
If Intersect(Target, Range("C5")) Is Unprotect Then
With ThisWorkbook.Sheets("Sheet1").UsedRange
.Value = .Value
End With
Else
End Sub
I know that the code unprotect is wrong but how do I ask if a cell value is unprotected, (even by the correct password), then replace formulas with numeric value.
Cheers
Lee
Hello Lee,Originally Posted by nbqleebarnes
As you appear aware that no matter what you do, in that Excel's known weaknesses can certainly be exploited by more than one program out there, attempting to build a bit of security is always helpful, as regardless of all, it decreases the chance that casual 'good-intentioned' users don't inadvertantly goober up the workbook.
To that end, I believe that you are actually looking to see if a particular sheet has become unprotected, instead of looking at whether a particular cell is "unprotected".
To wit: a cell's Locked property could be True or False, but this isn't really what you are looking for, as all cells are Locked by default. Instead, it is whether Protection has been "turned on" for the sheet.
For that, something like:
[VBA]Sub Whatever()
'// pass the sheet as an object//
SheetIsProtected Sheet1
End Sub
Sub SheetIsProtected(oSheet As Worksheet)
With oSheet.UsedRange
If oSheet.ProtectContents = False _
Or oSheet.ProtectDrawingObjects = False _
Or oSheet.ProtectScenarios = False Then
.Value = .Value
End If
End With
End Sub[/VBA]
Hopefully that helps a bit,
Mark
That works perfect and is exactly what I need, I will add it to my expiry and main macro.
I agree that any excel program is not safe but we can only but try to safe guard as much as we can against the amateur user.
Saying that I must allow my users to be able to use the program.
Just one other question I have is how do I make your code work automatically when a sheet is unprotected.
I am sure this is a bit of a stupid question. But having a blonde day.
Thanks for your help
Cheers
Lee
Hey Lee,
There are no 'stupid' questions, but occassionally a 'thick' reader, to wit, me. I'm afraid I'm not sure as what you mean by automatically working when a sheet is unprotected?
You could have it check to see if the sheet is protected whenever a sheet is activated, like:
[VBA]Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not UCase(Environ("UserName")) = "MARK" Then
SheetIsProtected Sh
End If
End Sub[/VBA]
...by placing the above in the ThisWorkbook Module. Please note that I pre-empted (spelling?) it from running if it's me, as you won't want to delete all your formulas if you have the workbook open and a sheet unprotected for developmental purposes. (I would certainly save a copy of my project before I tried this, just to avoid such a scenario)
Mark
Thanks for your good input to solving my problem Mark, I have figured it out eventually, I think it will help in the big picture of my excel workbooks.
I have used the following code:
Private Sub Worksheet_Activate()
'// pass the sheet as an object//
SheetIsProtected sheet1
End Sub
Sub SheetIsProtected(oSheet As Worksheet)
With oSheet.UsedRange
If oSheet.ProtectContents = False _
Or oSheet.ProtectDrawingObjects = False _
Or oSheet.ProtectScenarios = False Then
.Value = .Value
End If
End With
End Sub
Used this on each sheet and every time I click on the tab the formulas dissapear, it's great. I will remember to save a copy of my master, before I put it into my workbooks, that is why I have a user password and an admin password at the front of the workbook, I also put in an expiry period, protected the macros, I think that this is as much as I can do for protection for my users.
Thanks again for help.
Cheers
Lee
Glad to be of help Lee. Just to clarify, if you're putting the sub under each sheet's module, I believe you might want to simply call the procedure thusly:
[VBA]Private Sub Worksheet_Activate()
SheetIsProtected ActiveSheet
End Sub[/VBA]
...as 'sheet1' (at least the way its written) represents just the object 'sheet1'. Hopefully I'm not pointing out something you're already taking into account.
Anyways, glad its working for you, and have a good evening,
Mark
PS - I should have mentioned this earlier. When pasting code into the message window, first click on the little green and white button that says "VBA". Then just paste the code between the tags. Makes is a lot easier to read :-)
Thanks for all your help Mark,
I will make the adjustments you mentioned.
Cheers
Lee
Hi there again,
I input the code into my form as I require different access for user or admin which is as follows:
[vba]Private Sub CommandButton1_Click()
If Sheet15.Range("C1").Value = "user" Then
UserForm1.Hide
Sheet1.Visible = xlSheetVisible
Sheet2.Visible = xlSheetVisible
Sheet3.Visible = xlSheetVisible
Sheet4.Visible = xlSheetVisible
Sheet5.Visible = xlSheetVisible
Sheet6.Visible = xlSheetVisible
Sheet7.Visible = xlSheetVisible
Sheet8.Visible = xlSheetVisible
Sheet9.Visible = xlSheetVisible
Sheet10.Visible = xlSheetVisible
Sheet11.Visible = xlSheetVisible
Sheet12.Visible = xlSheetVisible
Sheet13.Visible = xlSheetVisible
Sheet14.Visible = xlSheetVisible
Sheet15.Visible = xlSheetVeryHidden
Chart16.Visible = xlSheetVisible
Chart17.Visible = xlSheetVisible
Chart18.Visible = xlSheetVisible
Chart19.Visible = xlSheetVisible
Chart20.Visible = xlSheetVisible
Chart21.Visible = xlSheetVisible
Chart22.Visible = xlSheetVisible
Chart23.Visible = xlSheetVisible
Chart24.Visible = xlSheetVisible
Chart25.Visible = xlSheetVisible
Chart26.Visible = xlSheetVisible
Chart27.Visible = xlSheetVisible
Chart28.Visible = xlSheetVisible
Sheet1.Select
Sheet15.Range("C1").Clear
Call Sheet1.Activate
Call Sheet2.Activate
Call Sheet3.Activate
Call Sheet4.Activate
Call Sheet5.Activate
Call Sheet6.Activate
Call Sheet7.Activate
Call Sheet8.Activate
Call Sheet9.Activate
Call Sheet10.Activate
Call Sheet11.Activate
Call Sheet12.Activate
Call Sheet13.Activate
Call Sheet14.Activate
Else
If Sheet15.Range("C1").Value = "admin" Then
UserForm1.Hide
Sheet1.Visible = xlSheetVisible
Sheet2.Visible = xlSheetVisible
Sheet3.Visible = xlSheetVisible
Sheet4.Visible = xlSheetVisible
Sheet5.Visible = xlSheetVisible
Sheet6.Visible = xlSheetVisible
Sheet7.Visible = xlSheetVisible
Sheet8.Visible = xlSheetVisible
Sheet9.Visible = xlSheetVisible
Sheet10.Visible = xlSheetVisible
Sheet11.Visible = xlSheetVisible
Sheet12.Visible = xlSheetVisible
Sheet13.Visible = xlSheetVisible
Sheet14.Visible = xlSheetVisible
Sheet15.Visible = xlSheetVeryHidden
Chart16.Visible = xlSheetVisible
Chart17.Visible = xlSheetVisible
Chart18.Visible = xlSheetVisible
Chart19.Visible = xlSheetVisible
Chart20.Visible = xlSheetVisible
Chart21.Visible = xlSheetVisible
Chart22.Visible = xlSheetVisible
Chart23.Visible = xlSheetVisible
Chart24.Visible = xlSheetVisible
Chart25.Visible = xlSheetVisible
Chart26.Visible = xlSheetVisible
Chart27.Visible = xlSheetVisible
Chart28.Visible = xlSheetVisible
Sheet1.Select
Sheet15.Range("C1").Clear
Else
UserForm2.Show
End If
End If
End Sub[/vba]
Then I have put into each sheet:
[vba]Private Sub Worksheet_Activate()
SheetIsProtected ActiveSheet
End Sub
Sub SheetIsProtected(oSheet As Worksheet)
With oSheet.UsedRange
If oSheet.ProtectContents = False _
Or oSheet.ProtectDrawingObjects = False _
Or oSheet.ProtectScenarios = False Then
.Value = .Value
End If
End With
End Sub[/vba]
Although whether I login as the user or admin then the formulas still dissapear no matter who I log in as.
I am using user form 1 as the input for the password and user form 2 to display "incorrect password".
I am sure I am missing something simple.
Hope you can help.
Cheers
Lee
Hello Lee,
I am late for hitting the rack (going to bed), but post an example workbbok, and someone will take a look or I'll get to tomorrow (er, today) afternoon. You can indeed shorten this up...
Mark
Hi Mark,
Keep forgetting you are on totally different time zone.
I have attached an example file with the code I'm using, I have had to protect the sheets, but I have not used any password, obviously because the moment I unprotect them and select the tab, then the formula dissapears.
You will see in the file that there is also a expiry code in there, the passwords that I have written in the code are "user" and "admin".
Get some sleep, chat later.
Cheers
Lee
Hi there,
I did add a macro enable code aswell that I found and I just need to get the code right for the user and admin access control.
I have added an example of the workbook.
Thanks in advance
Lee
Hello Lee,
Afraid yesterday was (and today may be as well) a bit busy. That said, I had a chance to
look at your workbook, albeit a very cursory look.
I applaud you, as it is clear to me that you are making great efforts in researching
articles from the KB here before asking. That said, I have noted some 'issues' in the way
things are currently working in the workbook (wb).
So... I will make at least one, if not more, suggestions as to changing a couple of things
up, that I believe will benefit - as in looking at the wb, it appears to me that correcting
these will make the smaller issues easier to resolve.
Hope that made sense, but maybe an example would be a better way of demonstrating
this, plus, I don't like being 'mysterious' as the goal is to be of help.
By example:
You end up with two opening events, as you have both a 'Private Sub Workbook_Open()'
(under the ThisWorkbook module) and 'Sub auto_open()' (under Module11). In gist, 'auto_open'
is antiquated and provided for backwards compatability, but has been replaced by
'Workbook_Open'.
As I don't use auto_open, I tested and believe that Workbook_Open processes first, thus - my
first suggestion would be to take everything in auto_open and place it below the code
currently in Workbook_Open, like:
[VBA]Private Sub Workbook_Open()
Dim StartTime#, CurrentTime#
With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call UnhideSheets
.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With
'*****************************************
'SET YOUR OWN TRIAL PERIOD BELOW
'Integers (1, 2, 3,...etc) = number of days use
'1/24 = 1Hr, 1/48 = 30Mins, 1/144 = 10Mins use
Const TrialPeriod# = 365 '< 1 year trial
'set your own obscure path and file-name
Const ObscurePath$ = "C:\"
Const ObscureFile$ = "TestFileLog.Log"
'*****************************************
If Dir(ObscurePath & ObscureFile) = Empty Then
StartTime = Format(Now, "#0.#########0")
Open ObscurePath & ObscureFile For Output As #1
Print #1, StartTime
UserForm1.Show
Else
Open ObscurePath & ObscureFile For Input As #1
Input #1, StartTime
CurrentTime = Format(Now, "#0.#########0")
If CurrentTime < StartTime + TrialPeriod Then
Close #1
UserForm1.Show
Exit Sub
Else
If [A1] <> "Expired" Then
MsgBox "Sorry, your trial period has expired - your data" & vbLf & _
"will now be extracted and saved for you..." & vbLf & _
"" & vbLf & _
"This workbook will then be made unusable."
Close #1
SaveShtsAsBook
[A1] = "Expired"
ActiveWorkbook.Save
Application.Quit
ElseIf [A1] = "Expired" Then
Close #1
Application.Quit
End If
End If
End If
Close #1
End Sub[/VBA]
...this way, we can step-thru the code and see what is happening.
Again, I hope that made sense...
Mark
Hi Mark,
Thanks for taking time to give me a hand while you are busy, I put the code into the workbook and it now looks like this:
[VBA]Option Explicit
Private Sub Workbook_Open()
Dim StartTime#, CurrentTime#
With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call UnhideSheets
.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With
'*****************************************
'SET YOUR OWN TRIAL PERIOD BELOW
'Integers (1, 2, 3,...etc) = number of days use
'1/24 = 1Hr, 1/48 = 30Mins, 1/144 = 10Mins use
Const TrialPeriod# = 365 '< 1 year trial
'set your own obscure path and file-name
Const ObscurePath$ = "C:\"
Const ObscureFile$ = "TestFileLog.Log"
'*****************************************
If Dir(ObscurePath & ObscureFile) = Empty Then
StartTime = Format(Now, "#0.#########0")
Open ObscurePath & ObscureFile For Output As #1
Print #1, StartTime
UserForm1.Show
Else
Open ObscurePath & ObscureFile For Input As #1
Input #1, StartTime
CurrentTime = Format(Now, "#0.#########0")
If CurrentTime < StartTime + TrialPeriod Then
Close #1
UserForm1.Show
Exit Sub
Else
If [A1] <> "Expired" Then
MsgBox "Sorry, your trial period has expired - your data" & vbLf & _
"will now be extracted and saved for you..." & vbLf & _
"" & vbLf & _
"This workbook will then be made unusable."
Close #1
SaveShtsAsBook
[A1] = "Expired"
ActiveWorkbook.Save
Application.Quit
ElseIf [A1] = "Expired" Then
Close #1
Application.Quit
End If
End If
End If
Close #1
End Sub
'
Private Sub UnhideSheets()
'
Dim Sheet As Object
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVisible
End If
Next
'
Sheets("Prompt").Visible = xlSheetVeryHidden
'
Application.Goto Worksheets(2).[A1], True '< Optional
'
Set Sheet = Nothing
ActiveWorkbook.Saved = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call HideSheets
.ScreenUpdating = True
.EnableCancelKey = xlInterrupt
End With
End Sub
Private Sub HideSheets()
'
Dim Sheet As Object '< Includes worksheets and chartsheets
'
With Sheets("Prompt")
'
'the hiding of the sheets constitutes a change that generates
'an automatic "Save?" prompt, so IF the book has already
'been saved prior to this point, the next line and the lines
'relating to .[A100] below bypass the "Save?" dialog...
If ThisWorkbook.Saved = True Then .[A100] = "Saved"
'
.Visible = xlSheetVisible
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVeryHidden
End If
Next
'
If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
End If
'
Set Sheet = Nothing
End With
'
End Sub
[/VBA]
and module 11 looks like this:
[VBA]Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xls"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Open MyFilePath & "\READ ME.log" For Output As #1
Print #1, "Thank you for trying out this product."
Print #1, "If it meets your requirements, call"
Print #1, "NBQ Quality Consulting on +2711 914 2274 to purchase"
Print #1, "the full (unrestricted) version..."
Close #1
End Sub
[/VBA]
However, when I do this, then I get an error on opening the workbook "Path/File access error" and then debug takes me to "Userform1.show".
I am pretty sure that it is because the user forms have not been loaded yet, but I don't know much. Do I need to put the "userform1.show" somewhere else in the workbook.
Thanks for your help.
Cheers
Lee
Hi Lee,
No problem whatsoever in taking a gander, there are many here who enjoy assisting.
As to the Path/File access error, in my limited experience, this seems to usually be a harmless but weird little glitch where compilation fails for some reason. Usually I have been able to save the wb, close and reopen, and everything is fine. Again, this is in my limited experience, but give that a try.
I do not believe it is anything to do with userform.show, as we didn't change the order of anything yet. (FYI - the userform automatically loads when .Show is invoked).
I don't see any difference, but just in case, here's a copy of the wb, with the auto_open deleted.
Also - my apologies, but I may or may not be on the forum for the next couple of days, as my truck has developed a major personality disorder... (L480E HD transmission appears to be fatal...). I will check the thread though when I can.
Thanks,
Mark
Hi Mark,
Just dragged myself out of bed, Sorry to hear about your transmission, what I know about cars is even less than VBA, which is not that much, although I am learning a lot with thanks to you. Not a problem if your busy, there is no real rush, and I would like to learn correct ways of writing code.
Anyway I took a look at the wb you attached, and for some reason yours works and mine doesn't, but not a problem, I have them both saved and I have looked through the code, I don't see any obvious differences, but saying this I am sure that you would have some additional suggestions for the code and maybe give me a hand with how I make the passwords for user and admin work properly, when the user logs on the code for deleting the formulas is activated and when the admin logs on then this code is ignored.
Once again, thanks for your help.
Cheers
Lee
P.S. I am trying in the mean time to get the code working.
Hi all,
Been out of town for last few days, could anyone give me hand with this one, as I am trying to get the two passwords to work correctly.
Thanks
Lee
Hello Lee,
I forgot about this for a bit, sorry about that.
Reference the attached, while trying to leave most of the code as-is, so that its not so different you can't tell what all is modified... I did change the following for your consideration:
In the code module for what was "UserForm1", which I replaced with
"frmPWord_AccessLevel", I eliminated some duplication of making sheets visible, as well as added a UserForm_QueryClose event to disable the form's dismiss button (the "X" button).
In the sheets' modules, I deleted, or more accurately, moved the 'SheetIsProtected' to Module11 and call it from the Workbook event: Workbook_SheetChange
In ThisWorkbook.UnhideSheets, I added a line to leave Sheet("FAD") hidden.
Probably one or two other tiny tweaks; hopefully I commented code well enough.
This should fix the issue of the password userform.
Mark
Posting Permissions
Reply With Quote
