Pas possible avec le fonction InputBox. Il faut définir un formulaire avec une TextBox
Cordialement, -- AP
"Alain79" a écrit dans le message de news: e69cf6$4se$
Salut Avez vous une idée pour que le texte saisie dans une inputbox apparaisse en mode password avec "*****" Merci Alain79
anonymousA
Bonjour,
possible mais avec les API
Voir ci-dessous à mettre dans un module standard. La sub TestDKInputBox peut être appelée par quelque méthode que tu souhaites.
A+
Option Explicit
'//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'http://www.danielklann.com/ 'March 2003
'// Kindly permitted to be amended '// Amended by Ivan F Moala '// http://www.xcelfiles.com '// April 2003 '// Works for Xl2000+ due the AddressOf Operator '////////////////////////////////////////////////////////////////////
'API functions to be used Private Declare Function CallNextHookEx _ Lib "user32" ( _ ByVal hHook As Long, _ ByVal ncode As Long, _ ByVal wParam As Long, _ lParam As Any) _ As Long
Private Declare Function GetModuleHandle _ Lib "kernel32" _ Alias "GetModuleHandleA" ( _ ByVal lpModuleName As String) _ As Long
Private Declare Function SetWindowsHookEx _ Lib "user32" _ Alias "SetWindowsHookExA" ( _ ByVal idHook As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadId As Long) _ As Long
Private Declare Function UnhookWindowsHookEx _ Lib "user32" ( _ ByVal hHook As Long) _ As Long
Private Declare Function SendDlgItemMessage _ Lib "user32" Alias "SendDlgItemMessageA" ( _ ByVal hDlg As Long, _ ByVal nIDDlgItem As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) _ As Long
Private Declare Function GetClassName _ Lib "user32" _ Alias "GetClassNameA" ( _ ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) _ As Long
Private Declare Function GetCurrentThreadId _ Lib "kernel32" () _ As Long
'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long
Dim RetVal Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If
strClassName = String$(256, " ") lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If
'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam
End Function
'// Make it public = avail to ALL Modules '// Lets simulate the VBA Input Function Public Function InputBoxDK(Prompt As String, Optional Title As String, _ Optional Default As String, _ Optional Xpos As Long, _ Optional Ypos As Long, _ Optional Helpfile As String, _ Optional Context As Long) As String
Dim lngModHwnd As Long, lngThreadID As Long
'// Lets handle any Errors JIC! due to HookProc> App hang! On Error GoTo ExitProperly lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) If Xpos Then InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context) Else InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context) End If
ExitProperly: UnhookWindowsHookEx hHook
End Function
Sub TestDKInputBox() Dim x
x = InputBoxDK("Type your password here.", "Password Required") If x = "" Then End If x <> "yourpassword" Then MsgBox "You didn't enter a correct password." End End If
MsgBox "Welcome Creator!", vbExclamation
End Sub
Alain79 wrote:
Salut Avez vous une idée pour que le texte saisie dans une inputbox apparaiss e en mode password avec "*****" Merci Alain79
Bonjour,
possible mais avec les API
Voir ci-dessous à mettre dans un module standard. La sub
TestDKInputBox peut être appelée par quelque méthode que tu
souhaites.
A+
Option Explicit
'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003
'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// http://www.xcelfiles.com
'// April 2003
'// Works for Xl2000+ due the AddressOf Operator
'////////////////////////////////////////////////////////////////////
'API functions to be used
Private Declare Function CallNextHookEx _
Lib "user32" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
Private Declare Function GetModuleHandle _
Lib "kernel32" _
Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String) _
As Long
Private Declare Function SetWindowsHookEx _
Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) _
As Long
Private Declare Function UnhookWindowsHookEx _
Lib "user32" ( _
ByVal hHook As Long) _
As Long
Private Declare Function SendDlgItemMessage _
Lib "user32" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Function GetClassName _
Lib "user32" _
Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long
Private Declare Function GetCurrentThreadId _
Lib "kernel32" () _
As Long
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the
Inputbox
'This changes the edit control so that it display the password
character *.
'You can change the Asc("*") as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR,
Asc("*"), &H0
End If
End If
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam
End Function
'// Make it public = avail to ALL Modules
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String,
_
Optional Default As String, _
Optional Xpos As Long, _
Optional Ypos As Long, _
Optional Helpfile As String, _
Optional Context As Long) As String
Dim lngModHwnd As Long, lngThreadID As Long
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd,
lngThreadID)
If Xpos Then
InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile,
Context)
Else
InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile,
Context)
End If
ExitProperly:
UnhookWindowsHookEx hHook
End Function
Sub TestDKInputBox()
Dim x
x = InputBoxDK("Type your password here.", "Password Required")
If x = "" Then End
If x <> "yourpassword" Then
MsgBox "You didn't enter a correct password."
End
End If
MsgBox "Welcome Creator!", vbExclamation
End Sub
Alain79 wrote:
Salut
Avez vous une idée pour que le texte saisie dans une inputbox apparaiss e en
mode password avec "*****"
Merci
Alain79
Voir ci-dessous à mettre dans un module standard. La sub TestDKInputBox peut être appelée par quelque méthode que tu souhaites.
A+
Option Explicit
'//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'http://www.danielklann.com/ 'March 2003
'// Kindly permitted to be amended '// Amended by Ivan F Moala '// http://www.xcelfiles.com '// April 2003 '// Works for Xl2000+ due the AddressOf Operator '////////////////////////////////////////////////////////////////////
'API functions to be used Private Declare Function CallNextHookEx _ Lib "user32" ( _ ByVal hHook As Long, _ ByVal ncode As Long, _ ByVal wParam As Long, _ lParam As Any) _ As Long
Private Declare Function GetModuleHandle _ Lib "kernel32" _ Alias "GetModuleHandleA" ( _ ByVal lpModuleName As String) _ As Long
Private Declare Function SetWindowsHookEx _ Lib "user32" _ Alias "SetWindowsHookExA" ( _ ByVal idHook As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadId As Long) _ As Long
Private Declare Function UnhookWindowsHookEx _ Lib "user32" ( _ ByVal hHook As Long) _ As Long
Private Declare Function SendDlgItemMessage _ Lib "user32" Alias "SendDlgItemMessageA" ( _ ByVal hDlg As Long, _ ByVal nIDDlgItem As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) _ As Long
Private Declare Function GetClassName _ Lib "user32" _ Alias "GetClassNameA" ( _ ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) _ As Long
Private Declare Function GetCurrentThreadId _ Lib "kernel32" () _ As Long
'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long
Dim RetVal Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If
strClassName = String$(256, " ") lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If
'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam
End Function
'// Make it public = avail to ALL Modules '// Lets simulate the VBA Input Function Public Function InputBoxDK(Prompt As String, Optional Title As String, _ Optional Default As String, _ Optional Xpos As Long, _ Optional Ypos As Long, _ Optional Helpfile As String, _ Optional Context As Long) As String
Dim lngModHwnd As Long, lngThreadID As Long
'// Lets handle any Errors JIC! due to HookProc> App hang! On Error GoTo ExitProperly lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) If Xpos Then InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context) Else InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context) End If
ExitProperly: UnhookWindowsHookEx hHook
End Function
Sub TestDKInputBox() Dim x
x = InputBoxDK("Type your password here.", "Password Required") If x = "" Then End If x <> "yourpassword" Then MsgBox "You didn't enter a correct password." End End If
MsgBox "Welcome Creator!", vbExclamation
End Sub
Alain79 wrote:
Salut Avez vous une idée pour que le texte saisie dans une inputbox apparaiss e en mode password avec "*****" Merci Alain79