0

第二个帖子在这里。我要做的就是更改密码以保护和取消保护我的工作簿，如我在此处的代码中定义的那样......

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
4

2 回答 2

1

当它的密码必须存储在某个地方时。我在下面的代码中使用了一个范围并将其命名为 password 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
于 2013-06-07T03:29:47.360 回答
0

虽然简单地调用对话框来设置工作簿保护可能更容易（即，如果不同的工作表需要不同的密码，此方法将出现错误，我试图捕获这种错误）并使用内置对话框，这个会做你所要求的。

与往常一样，记住您的密码。我不提供找回丢失密码的方法。

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
于 2013-06-07T03:13:56.947 回答