Userform to enter a password - then write text into a formfield

[illogic]

Hello,


i would like to create a mask (maybe a userform) for a password entry. When the password is entered a certain text is written to a formfield.

For example:

(Certain users get different passwords and each password is related to a certain name)

1. A click into the formfield activates the input mask
2. The password needs to be entered into the mask
3. The macro checks which password was entered and writes the related text into the formfield.

How could i realize something like this?


greetings

Manuel

[illogic]

Hello,

i created a Userform for the password entry.
The Userform contains a text entry field for the actual password and two command buttons to confirm or cancel.

If i am correct, i need a module where i define the names and the passwords that are related to these names.
And the code in the userform which checks if the entered password is correct and which name needs to be written to the formfield.

I currently use this code in the userform:


Const strPass As String = "Password"

Private Sub UserForm_Initialize()
TextBox1.ForeColor = &H808080
TextBox1.Text = strPass
cmdOK.SetFocus
End Sub

Private Sub TextBox1_Enter()
With Me.TextBox1
If .Text = strPass Then .Text = vbNullString
End With
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
With Me.TextBox1
If .Text <> strPass Then
TextBox1.ForeColor = &H80000008
TextBox1.PasswordChar = "*"
End If
End With
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.TextBox1
If .Text = vbNullString Then .Text = strPass
End With
End Sub

But now i need a solution for the command button to confirm the entry.
How can i achieve that by clicking ok, the code checks if the entered password matches the defined passwords in a another module and writes the related text to a formfield?

Any ideas would be much appreciated.

Greetings

Manuel

[gmayor]

See the attached example. It will force the use of macros and will not allow the editing of the document unless you do so. The macro will then prompt for the password, which must be entered correctly from one of several. You can view the code if you hold the shift key while opening the document (you should password protect the code in your version).

[illogic]

Thanks for your reply!
I managed to implement your code example into my macro.
I had to udjust some of it, but it works.

In This Document:

Sub frmPW_Show()
Dim oFrm As frmPW
Set oFrm = New frmPW
With oFrm
.Show
Select Case .TextBox1.Text
Case "0000": ActiveDocument.FormFields("Aussteller").Result = ""
ActiveDocument.FormFields("Ort").Select
Case "0001": ActiveDocument.FormFields("Aussteller").Result = "J.D."
ActiveDocument.FormFields("Ort").Select
Case "0002": ActiveDocument.FormFields("Aussteller").Result = "J.D.D"
ActiveDocument.FormFields("Ort").Select
Case Else
MsgBox "Kennziffer existiert nicht." & vbCr & vbCr & _
"Bitte korrekte Kennziffer eingeben."
ActiveDocument.FormFields("Ort").Select

End Select
End With
Unload frmPSA
Set oFrm = Nothing
lbl_Exit:
Exit Sub
End Sub


In the Userform:

Private Sub cmdOK_Click()
Me.Hide
Me.Tag = 1
lbl_Exit:
Exit Sub
End Sub

There is another problem i am currently having with the code.
Whenever the password is not entered correctly and the error message appears, the userform closes and it has to be started again by clicking into the formfield.
Is it somehow possible to automate that? So that the password entry loops itself until the password is entered correctly?

Its not a big deal if it doesn't work. But it would be nice to have.

[gmayor]

You could do that, but you will need to add another command button to the form to allow the user to cancel from the never ending loop. The userform code would be something like

Option Explicit

Private Sub btnCancel_Click()
Me.Hide
Me.Tag = 0
lbl_Exit:
Exit Sub
End Sub

Private Sub btnContinue_Click()
Me.Hide
Me.Tag = 1
lbl_Exit:
Exit Sub
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
lbl_Exit:
Exit Sub
End Sub


Your code modifications do not include the macro warning on the main form, nor the password which allows that text to be removed. Using your code as an example you would need something like


Option Explicit

Private Sub Document_Open()
Dim oFrm As New frmPassword
ActiveDocument.Unprotect Password:="Edit" 'Add a password of your choice and protect the document for read only before saving it using the password.
ActiveDocument.Paragraphs(1).Range.Delete
Start:
With oFrm
.Show
If .Tag = 0 Then
ActiveDocument.Close wdDoNotSaveChanges
GoTo lbl_Exit
End If
Select Case .TextBox1.Text
Case "0000": ActiveDocument.FormFields("Aussteller").Result = ""
ActiveDocument.FormFields("Ort").Select
Case "0001": ActiveDocument.FormFields("Aussteller").Result = "J.D."
ActiveDocument.FormFields("Ort").Select
Case "0002": ActiveDocument.FormFields("Aussteller").Result = "J.D.D"
ActiveDocument.FormFields("Ort").Select
Case Else
MsgBox "Kennziffer existiert nicht." & vbCr & vbCr & _
"Bitte korrekte Kennziffer eingeben."
.TextBox1.Text = ""
.TextBox1.SetFocus
GoTo Start
End Select
ActiveDocument.FormFields("Ort").Select
End With
ActiveDocument.Protect _
Type:=wdAllowOnlyFormFields, _
NoReset:=True, _
Password:=""
lbl_Exit:
Unload oFrm
Set oFrm = Nothing
Exit Sub
End Sub