Question

这里的第二篇文章。我想要做的就是更改密码以保护和取消保护我的代码中定义的工作簿...

Dim myPassword As String
myPassword = "yogurt"                     'defines the password

For Each sh In ActiveWorkbook.Worksheets  'unprotects the sheet for editing
    sh.Unprotect Password:=myPassword
Next sh

...使用另一个名为“更改密码”的宏，其中用户输入当前密码，然后输入新密码。

如果用户键入两次新密码以确保准确性，我只希望“更改密码”宏能够正常工作。

任何快速建议？

非常感谢。

Sub change_password() 
Dim OldPassword, MyPassword, NewPassword As String 
Dim pass1, pass2 
MyPassword = monkey 
OldPassword = InputBox("Please enter the old password.") 
    If OldPassword = MyPassword Then 
        pass1 = InputBox("Enter the new password.") 
        pass2 = InputBox("Enter the new password again to ensure accuracy.") 
    If pass1 = pass2 Then 
        MyPassword = pass1 
    Else 
        MsgBox "The new password you entered was not entered correctly both times." 
    End If 
End If 
MsgBox ("Your new password is" & MyPassword) 
End Sub

Answer 1

当密码必须存储在某个地方时。我在下面的代码中使用了一个范围，并将其命名为密码Range("password")。

Dim OldPassword As String
Dim NewPassword As String

Sub change_password(ByRef blnIsChanged)

    Dim pass1 As String, pass2 As String, myPassword As String

    myPassword = Range("password")
    OldPassword = InputBox("Please enter the old password.")

    If OldPassword = myPassword Then
        pass1 = InputBox("Enter the new password.")
    Else
        MsgBox "Old password not matching", vbInformation
        Exit Sub
    End If

    pass2 = InputBox("Enter the new password again to ensure accuracy.")
    If pass1 = pass2 Then
        Range("password") = pass1
        NewPassword = pass1
        blnIsChanged = True
        MsgBox ("Your new password is " & myPassword)
    Else
        MsgBox "The new password you entered was not entered correctly both times."
    End If


End Sub


Sub btnGO()

    Dim blnPassword As Boolean
    change_password blnPassword

    If blnPassword Then
        For Each sh In ActiveWorkbook.Worksheets
            sh.Unprotect Password:=OldPassword ' Unprotect with old password
            'your cod here
            sh.Protect Password:=NewPassword
        Next sh
    End If
End Sub

Answer 2

虽然简单地调用对话框来设置工作簿保护可能更容易（即，如果不同的工作表需要不同的密码，这种方法会有错误，我试图捕获这种错误）并使用内置的对话框，这几乎可以满足您的要求。

与往常一样，请记住您的密码。我没有提供检索丢失密码的方法。

Option Explicit
Public badpassword As Boolean

Sub changepassword()
    Dim sh As Worksheet
    Dim pw1 As String

    Dim newpw As String
    Dim newpw2 As String
    badpassword = True
    'enter the current password, twice
    pw1 = enterpassword("Please enter the password to UNPROTECT the sheets")

    'prompt for a new password
    newpw = enterpassword("Please enter the new password")
    newpw2 = enterpassword("Please re-enter the new password")
    If newpw <> newpw2 Then
        '## inform the user that the passwords don't match
        MsgBox "The passwords are not the same", vbCritical
    Else:
        '## Attempt to change the password on each sheet
        For Each sh In ActiveWorkbook.Worksheets
            On Error GoTo badpassword '## provide a means of escaping error if password is incorrect
            protectsheet sh, pw1, newpw
            On Error GoTo 0
            If badpassword Then
                MsgBox "The password you entered is incorrect for sheet:" & sh.Name _
                    , vbCritical
                '## allow the macro to continue on other worksheets:
                badpassword = False
            End If
        Next
    End If

    Exit Sub
badpassword:
    '## Trap errors if the supplied password is invalid
    badpassword = True
    Resume Next
End Sub

Function enterpassword(Optional msg As String = "Please enter the password")
    Dim pw$
    pw = InputBox(msg, "Password?")
    enterpassword = pw
End Function

Sub protectsheet(sh As Worksheet, pw As String, newpw As String)
    sh.Unprotect pw
    sh.protect newpw
    badpassword = False 'indicates a success
End Sub

使用vba中的另一个宏更改一个宏中的变量

2 个答案: