0

2回目の投稿はこちら。私がしたいのは、ここのコードで定義されているように、パスワードを変更してワークブックを保護および保護解除することだけです...

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

...「パスワードの変更」などと呼ばれる別のマクロを使用して、ユーザーが現在のパスワードを入力し、新しいパスワードを入力できるようにします。

ユーザーが正確さを確保するために新しいパスワードを2回入力した場合にのみ、「パスワードの変更」マクロが機能するようにします。

簡単な提案はありますか？

どうもありがとう。

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

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 に答える