Juan Pablo González
MrExcel MVP
- Joined
- Feb 8, 2002
- Messages
- 11,959
Hello. After seeing quite a few posts about "How can I use an Inputbox that shows "*" instead of the actual characters, to protect the password being entered ?" and the usual response, you have to create an Userform to do that, well, I decided to do something about that, and with the help of Ivan F Moala, came up with this class module that enables you to have just that, an Inputbox that has the option to use a "Password character", such as "*"
Here's the code for the class module
Name it something like PwdInputBox
and here's an example Sub to show how it works.
Here's the code for the class module
Name it something like PwdInputBox
Code:
'---------------------------------------------------------------------------------------
' ClassModule : PwdInputBox
' DateTime : 30/07/02 10:30
' Last modified : 31/07/02 08:49
' Author : Juan Pablo Gonzalez
' Special thanks to Ivan F Moala for pointing the right way
' Purpose : Shows a standard InputBox but with the cabalitie to have a PasswordChar
' for the text entered.
' Parameters : Prompt As String, required. Text to show on the InputBox
' PasswordChar As String, optional. Character to show as PasswordChar.
' If vbNullString is entered, the text will show up normally.
' Title As String, optional. Title of the InputBox
' Default As String, optional. Default text to show (Will appear with the
' PasswordChar selected. String character to hide the text entered
' XPos As Long, optional. Horizontal distance between the left border of
' the dialog, and the left border of the screen
' YPos As Long, optional. Vertical distance between the upper border of
' the dialog, and the upper border of the sreen
' Outputs : Variant. Is pressed Ok, the text entered. If pressed Cancel, False
'---------------------------------------------------------------------------------------
Option Explicit
Function PassInputBox(Prompt As String, Optional PasswordChar As String, Optional Title As String, Optional Default As String, Optional XPos As Long, Optional YPos As Long)
Dim UF 'Store the VBComponent
Dim VUF As Object 'Store the userform object
Dim Lb As Object 'Label for the Prompt
Dim Tb As Object 'TextBox which holds the password
Dim BOk As Object
Dim BCancel As Object
Dim VBAVisible As Boolean 'Store VBE.Mainwindow visible state to restore it
Dim i As Integer
'Default Title is the same as InputBox
If Len(Title) = 0 Then Title = Application.Name
'Store the visible property of the VBE mainwindow and hide it to prevent screen flashing
VBAVisible = Application.VBE.MainWindow.Visible
Application.VBE.MainWindow.Visible = False
'Add temporary Userform
Set UF = ThisWorkbook.VBProject.VBComponents.Add(3)
'Add the textbox. If no PasswordChar was supplied, the text will appear normally
Set Tb = UF.Designer.Controls.Add("Forms.Textbox.1", "TextBox1")
With Tb
.PasswordChar = PasswordChar
.Left = 4.5
.Top = 69.75
.Width = 254.25
.Height = 15.75
.Value = Default
End With
'Add the prompt
Set Lb = UF.Designer.Controls.Add("Forms.Label.1")
With Lb
.Caption = Prompt
.WordWrap = True
.Left = 6.75
.Top = 6.75
.Width = 198
.Height = 54
End With
'Button OK, it is the default button
Set BOk = UF.Designer.Controls.Add("Forms.CommandButton.1", "BOk")
With BOk
.Caption = "OK"
.Left = 209.25
.Top = 4.5
.Width = 49.5
.Height = 18
.Default = True
End With
'Button Cancel
Set BCancel = UF.Designer.Controls.Add("Forms.CommandButton.1", "BCancel")
With BCancel
.Caption = "Cancel"
.Cancel = True
.Left = 209.25
.Top = 27
.Width = 49.5
.Height = 18
End With
'Add code to the Userform module
With UF.CodeModule
i = .CountOfLines
'MyText is a variant which will hold the answer the user pressed
.InsertLines i + 0, "Public MyText as Variant"
'Pressed Cancel, so assign False to MyText
.InsertLines i + 1, "Private Sub BCancel_Click()"
.InsertLines i + 2, " MyText = False: Me.Hide"
.InsertLines i + 3, "End Sub"
'Pressed Ok, so assign the value of TextBox1 to MyText
.InsertLines i + 4, "Private Sub BOk_Click()"
.InsertLines i + 5, " MyText = TextBox1.Value: Me.Hide"
.InsertLines i + 6, "End Sub"
'Closing the form using "X", so assign False to MyText
.InsertLines i + 7, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
.InsertLines i + 8, " If CloseMode = 0 Then Cancel = True: MyText = False: Me.Hide"
.InsertLines i + 9, "End Sub"
End With
'Properties for the userform
With UF
.Properties("Caption") = Title
.Properties("Width") = 273
.Properties("Height") = 108.75
'Center on screen or show in a specific position
If XPos > 0 Or YPos > 0 Then
.Properties("StartUpPosition") = 0
.Properties("Left") = XPos
.Properties("Top") = YPos
Else
.Properties("StartUpPosition") = 1
End If
End With
'Include the UF in the Userforms collection
Set VUF = VBA.UserForms.Add(UF.Name)
'Show the Userform
VUF.Show
'Pass the result to this function
PassInputBox = VUF.MyText
'Remove the VBcomponet
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UF
'Restore the VBE Mainwindow
Application.VBE.MainWindow.Visible = VBAVisible
End Functionand here's an example Sub to show how it works.
Code:
Sub TestMe()
Dim ans As Variant 'ans is declared Variant to work similar to Application.InputBox
Dim App As PwdInputBox 'Reference the class module
Set App = New PwdInputBox 'Create a new instance
ans = App.PassInputBox("Please enter the password", "*", "My Application") 'Show the Inputbox and store the result
If ans = False Then
MsgBox "Pressed Cancel"
Else
MsgBox "The password entered is: " & ans
End If
End Sub
