Password in Excel Input Text Box

  Desert Andy 13:51 08 Oct 04
Locked

I want to set up the user to put in a Password in a Input Text Box. I want to hide the text the user inputs, I was thinking about using the PasswordChar[] code in vb. However, there is no example in the help files on how to use this code. Can anybody help please.

Thanks
Andy

  VoG II 21:00 08 Oct 04

'---------------------------------------------------------------------------------------


' Author : Juan Pablo Gonzalez


'---------------------------------------------------------------------------------------



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 + 1, "Public MyText as Variant"

'Pressed Cancel, so assign False to MyText

.InsertLines i + 2, "Private Sub BCancel_Click()"

.InsertLines i + 3, " MyText = False: Me.Hide"

.InsertLines i + 4, "End Sub"

'Pressed Ok, so assign the value of TextBox1 to MyText

.InsertLines i + 5, "Private Sub BOk_Click()"

.InsertLines i + 6, " MyText = TextBox1.Value: Me.Hide"

.InsertLines i + 7, "End Sub"

'Closing the form using "X", so assign False to MyText

.InsertLines i + 8, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"

.InsertLines i + 9, " If CloseMode = 0 Then Cancel = True: MyText = False: Me.Hide"

.InsertLines i + 10, "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 Function

  VoG II 21:01 08 Oct 04

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

This thread is now locked and can not be replied to.

How to get Windows 10 for free | How to install Windows 10: There is still a way to avoid paying…

1995-2015: How technology has changed the world in 20 years

Alex Chinneck’s giant ice cube Christmas tree at Kings Cross

Apple rumours & predictions 2017: The iPhone 8, new iPads, and everything else you should expect fr7…