protect and unprotect by inputbox to add a new sheet

0

hi

  I  have  this   code   but  I'm stucking ,  my  idea  depends  on   prevent  user  from add a new  sheet    it  pop warning  message   and  show  inputbox   to  add  the password      if   the   password  is  right  then  unprotect   the  file   and   enable   to  add  a new  sheets  and  if  the  password  is  wrong  then  pop message  inform  me   wrong  password  and  continue  show   inputbox  until  put  the  right  password  and  if  i  press  cancel   then exit  sub  .

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Const myPwd As String = "qwe"
Dim ans
ActiveWorkbook.Protect Password:=myPwd
Application.DisplayAlerts = False
ActiveSheet.Delete
MsgBox "Sorry, Adding new Sheet is not allowed"
ans = InputBox("YOur code", "Modify")
If ans <> myPwd Then MsgBox "Sorry, the password is not  correct": ans = InputBox("YOur code", "Modify")
If ans = myPwd Then ActiveWorkbook.Unprotect Password:=myPwd
ActiveWorkbook.Sheets.Add
End Sub

Answer
Discuss

Answers

0
Selected Answer

Hello Maklil,

Your question has three questions. The one about lifting protection is very complicated and you appear to have a handle on it. The one about preventing addition of a sheet isn't sufficiently explained. Therefore I will only deal with the one about entering the password. Usually one would use an independent function for that which returns True or Not True (False). Here is the function.

Function AccessGranted(ByVal Pass As String) As Boolean
    ' 258
    ' return Not True if no valid password was entered

    Dim Pwd         As Variant
    Dim Ask         As VbMsgBoxResult

    Do
        Pwd = InputBox("Enter password:")
        If Len(Trim(Pwd)) = 0 Then Exit Do

        If StrComp(Pwd, Pass, vbBinaryCompare) Then
            Ask = MsgBox("Sorry, the password you entered isn't recognized." & vbCr & _
                         "The password is case sensitive." & vbCr & _
                         "Do you want to try again?", _
                         vbYesNo, "Wrong password")
            If Ask <> vbYes Then Exit Do
        Else
            AccessGranted = True
            Exit Do
        End If
    Loop
End Function

If you add it to a class module I would suggest to make its scope Private.

You can call the function as shown below but I didn't test this procedure.


Private Sub Workbook_NewSheet(ByVal Sh As Object)
    ' 258

    Const myPwd As String = "qwe"


    If Not AccessGranted(myPwd) Then
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Sh.Parent.Protect Password:=myPwd       ' safer than "ActiveWorkbook"
        Application.DisplayAlerts = True
    End If
End Sub
Discuss

Discussion

thanks    this  is  exactly  what   I  want     but   I  note  it  shows  many  errors   'object require   if  close  inputbox  or  press cancel  or leave  empty inputbox   and  press  ok  or  if  press no   when  show  message  in this  line 
Sh.Parent.Protect Password:=myPwd       ' safer than "ActiveWorkbook"
MAKLIL (rep: 18) Jun 8, '21 at 2:36 am
variatus  many thanks for your solution , I fixed by add this line and works
on error resume next 
MAKLIL (rep: 18) Jun 8, '21 at 4:35 am
Hi Maklil, I told you that I didn't deal with the question of protection and that I didn't test your code. I know that the function I provided is exactly what you wanted. So, please select the answer, work on your qestion about protection - because it's a complicated subject you need to prepare well - and then ask your question in another thread. In fact, I'm not convinced that the way you handle the addition of the sheet, using a workbook event, is optimal. Workbook events occur for any open workbook, not only the one you are thinking of. Your reference to ActiveSheet shows that you didn't consider that. I recommend that you find a way to solve the problem of adding sheets first, preferrably using Worksheet events only, and deal with protection  last, when everything is working smoothly.
Variatus (rep: 4729) Jun 8, '21 at 4:37 am
Hahaha, Maklil. So you told Excel to be quiet and not inform you of errors and now you think your code is working. How could that be?  As a broad rule, On Error Resume Next must always be followed by a line of code that handles the error. In this particular case, the protection is not being set. If that is what you want to accept you can take out both, the line that causes the error and On Error Resume Next. But thatnk you for selecting my answer. :-)
Variatus (rep: 4729) Jun 8, '21 at 4:44 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login