Mask input in input boxes?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Is it possible to put an input mask on an input box? I'd like for the user to input a password and for the characters to come up as *'s. I think this would be possible if I made a form to do it, but it would be easier if I could do it for an input box

Thanks

Eric
 
Eric,

It can't be done with an InputBox. You need to use a user from
with a text box whose PasswordChar property is set to '*'.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com



Eric said:
Is it possible to put an input mask on an input box? I'd like
Click to expand...
for the user to input a password and for the characters to come
up as *'s. I think this would be possible if I made a form to do
it, but it would be easier if I could do it for an input box.
 
Hi Eric;
Private Declare Function GetClassName& Lib "user32" Alias _
"GetClassNameA" (ByVal hWnd&, ByVal lpClassName$, ByVal nMaxCount&)
Private Declare Function GetWindowLong& Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd&, ByVal nIndex&)
Private Declare Function IsWindow& Lib "user32" (ByVal hWnd&)
Private Declare Function SetWindowsHookEx& Lib "user32" Alias _
"SetWindowsHookExA" (ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal
dwThreadId&)
Private Declare Function SetWindowPos& Lib "user32" _
(ByVal hWnd&, ByVal hWndInsertAfter&, ByVal x&, ByVal y& _
, ByVal cx&, ByVal cy&, ByVal wFlags&)
Private Declare Function SetWindowLong& Lib "user32" _
Alias "SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Declare Function UnhookWindowsHookEx& Lib "user32" (ByVal hHook&)
Private Declare Function GetCurrentThreadId Lib "KERNEL32" () As Long

Private Type CWPSTRUCT
lParam As Long
wParam As Long
Message As Long
hWnd As Long
End Type

Private MyHook&

Sub PasswordInput()
Dim Prompt As String
#If VBA6 Then
MyHook = SetWindowsHookEx(4, AddressOf InputWndProc, 0,
GetCurrentThreadId)
#Else
MyHook = SetWindowsHookEx(4, AddrOf("InputWndProc"), 0,
GetCurrentThreadId)
#End If
Prompt = InputBox("Enter your password !", "Masked input")
If Not Prompt = "" Then MsgBox "The password is: " & Prompt
End Sub

Private Function InputWndProc&(ByVal nCode&, ByVal wParam&, Struct As
CWPSTRUCT)
If Struct.Message <> &H1 Then Exit Function
Dim hWnd&, oldStyle&, iClass As String
hWnd = Struct.hWnd
oldStyle = GetWindowLong(hWnd, -16)
iClass = GetWindowClass(hWnd)
If iClass = "edit" Then
oldStyle = oldStyle Or &H20&
SetWindowLong hWnd, -16, oldStyle
SetWindowPos hWnd, 0, 0, 0, 180, 20, &H2
UnhookWindowsHookEx MyHook
End If
End Function

Private Function GetWindowClass$(ByVal hWnd&)
Dim Buffer As String, iPos As Byte
If IsWindow(hWnd) Then
Buffer = String(255, 0)
Call GetClassName(hWnd, Buffer, 256)
iPos = InStr(Buffer, Chr(0))
Buffer = IIf(iPos, Left(Buffer, iPos - 1), Buffer)
GetWindowClass = LCase(Buffer)
End If
End Function

MP

Eric said:
Is it possible to put an input mask on an input box? I'd like for the
Click to expand...
user to input a password and for the characters to come up as *'s. I think
this would be possible if I made a form to do it, but it would be easier if
I could do it for an input box.
 
For excel97, you must add:
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias _
"EbGetExecutingProj" (hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId"
_
(ByVal hProject As Long, ByVal strFunctionName As String _
, ByRef strFunctionID As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias
"TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, ByVal strFunctionID As String _
, ByRef lpfnAddressOf As Long) As Long

#If VBA6 Then
#Else
'* AddressOf operator replacement for Office97 VBA
'* Authors: Ken Getz and Michael Kaplan
Private Function AddrOf(CallbackFunctionName As String) As Long
Dim aResult As Long, CurrentVBProject As Long, strFunctionID As String
Dim AddressOfFunction As Long, UnicodeFunctionName As String

'* Convert the name of the function to Unicode system
UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)
'* If the current VBProjects exists...
If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
'* ...get the function ID of the callback function, based on its
'* unicode-converted name, in order to ensure that it exists
aResult = GetFuncID(hProject:=CurrentVBProject, _
strFunctionName:=UnicodeFunctionName, strFunctionID:=strFunctionID)
'* If the function exists indeed ...
If aResult = 0 Then
' *...get a pointer to the callback function based on
' * the strFunctionID argument of the GetFuncID function
aResult = GetAddr(hProject:=CurrentVBProject, _
strFunctionID:=strFunctionID, lpfnAddressOf:=AddressOfFunction)
'* If we've got the pointer pass it to the result of the function
If aResult = 0 Then AddrOf = AddressOfFunction
End If
End If
End Function
#End If

Eric said:
Is it possible to put an input mask on an input box? I'd like for the
Click to expand...
user to input a password and for the characters to come up as *'s. I think
this would be possible if I made a form to do it, but it would be easier if
I could do it for an input box.
 
Back
Top