password avec *

Version imprimable

password avec *

Code:

1 2 3 4 5 6 7 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) PWD = InputBox("Enter the password:", "PRIVATE ACCESS") def = "******" If PWD = "password" Then _ Cancel = False _ Else Cancel = True End Sub
le code en rouge ne fait rien je croyais que c etait ca pour mettre le password en *****
merci d avance pour la solution!

Je suis pas sur que une inputbox permette de mettre des * a la place de la saisie mais si c'est le cas ca m'interresse.
Par contre dans mon cas je me suis créé un petit userform contenant un textbox contenant un textbox auquel j'ai mis l'atribut Password = "*" et la ca marche
tu as juste a créer un bouton valider, un autre annuler etc...
Bonne chance
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub BtAnnuler_Click() 'Ferme la fenetre Unload Me End Sub Private Sub BtValider_Click() 'Si le mot de passe est correct If UCase(TxtMotdePasse.Value) = "ton mot de passe" Then tes instructions en cas de bon mot de passe Unload Me Else MsgBox "Mot de passe non valide", vbExclamation + vbOKOnly, "Erreur" End If End Sub
Edit : TxtMotdePasse est mon textbox
Edit2 : Désoler j'ai fait une fausse manip je ne tiendrai aucune rencune au modo qui effacera mon premier post

04/02/2008, 16h49
tomy7

re

si c est possible je l ai fai y a une heure et j ai perdu le fichier a cause d une fausse manip . t inquite je post la solution des que je l ai.

C'est possible mais un peu compliqué :
pour le lancer

Code:

inputboxPassWord("Entre le mot de passe")

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Option Explicit
 
Private Declare Function apiCallNextHookEx _
    Lib "user32" Alias "CallNextHookEx" ( _
    ByVal hHook As Long, _
    ByVal ncode As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
As Long
Private Declare Function apiGetModuleHandle _
    Lib "kernel32" _
    Alias "GetModuleHandleA" ( _
    ByVal lpModuleName As String) _
As Long
Private Declare Function apiSetWindowsHookEx _
    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 apiUnhookWindowsHookEx _
    Lib "user32" _
    Alias "UnhookWindowsHookEx" ( _
    ByVal hHook As Long) _
As Long
Private Declare Function apiSendDlgItemMessage _
    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 apiGetClassName _
    Lib "user32" _
    Alias "GetClassNameA" ( _
    ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) _
As Long
Private Declare Function apiGetCurrentThreadId _
    Lib "kernel32" Alias "GetCurrentThreadId" () _
As Long
 
 
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 InputBoxPassWord(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 lngThreadID As Long
Dim lngModHwnd As Long
 
On Error GoTo Sortie
lngThreadID = apiGetCurrentThreadId
lngModHwnd = apiGetModuleHandle(vbNullString)
 
hHook = apiSetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
If Xpos Then
    InputBoxPassWord = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
    InputBoxPassWord = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If
 
Sortie:
apiUnhookWindowsHookEx hHook
 
End Function
 
Public Function NewProc(ByVal lngCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
Dim Ret As Long
Dim lngBuff As Long
Dim strClassName As String
 
If lngCode < HC_ACTION Then
    NewProc = apiCallNextHookEx(hHook, lngCode, wParam, lParam)
    Exit Function
End If
strClassName = String$(256, " ")
lngBuff = 255
If lngCode = HCBT_ACTIVATE Then
    Ret = apiGetClassName(wParam, strClassName, lngBuff)
    If Left$(strClassName, Ret) = "#32770" Then
        apiSendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
    End If
End If
 
apiCallNextHookEx hHook, lngCode, wParam, lParam
End Function

04/02/2008, 19h06
Singular

Citation:

Envoyé par zebulon2212

Edit2 : Désoler j'ai fait une fausse manip je ne tiendrai aucune rencune au modo qui effacera mon premier post

Tu peux l'effacer toi-même en éditant le message et en cliquant l'option "Suppression logique du message", dans le haut de la page.

bonsoir à tous

il me semble que tu peux faire tout simplement

Code:

1
2
3
4
5
6
7
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
PWD = InputBox("Enter the password:", "PRIVATE ACCESS", "******")
'def = "******"
If PWD = "password" Then _
Cancel = False _
Else Cancel = True
End Sub

cordialement

05/02/2008, 00h02
Bigalo

fred,

Ton code ne marche pas : ce qui est entré dans l’InpuBox par l’utilisateur est visible (vérifié avec Excel 2004 et 2007).
05/02/2008, 00h10
ouskel'n'or

1 pièce(s) jointe(s)

Pièce jointe 25099
Regarde si ça t'irait
Bonne soirée

(Tu importes ces deux fichiers dans ton projet, comporte un userform pour le logon et le code de la saisie du mot de passe sous forme d'étoiles)
05/02/2008, 00h10
fred65200

bonsoir Bigalo,

:oops:
ça m'apprendra à lire les sujets en diagonal. Effectivement ce code n'est pas fait pour afficher des * lors de la saisie, mais comme valeur par défaut.

fred

Edit
Bonsoir ouskel'n'or

toi aussi tu lis trop vite.

:lol:

apres une nuit de recherche .
C'est ca que j avais fais :
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Message, Title, Default, MyValue Message = "Enter the password:" Title = "PRIVATE ACCESS" Default = "*****" PWD = InputBox(Message, Title, Default) If PWD = "password" Then _ Cancel = False _ Else Cancel = True End Sub
cela affiche juste les etoiles par defaut mais des que l on fait delete on repasse en ecriture normal.
Donc je vais passer par un Userform avec le mode passwordchar.
Desole de vous avoir fais chercher pour rien.

Merci a tous!:king:

pas pour rien :p puisque l'on a pu voir que c'est possible mais uniquement pas les API sauf à développer un userform spécifique.
Citation:
Envoyé par tomy7
apres une nuit de recherche .
C'est ca que j avais fais :
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Message, Title, Default, MyValue Message = "Enter the password:" Title = "PRIVATE ACCESS" Default = "*****" PWD = InputBox(Message, Title, Default) If PWD = "password" Then _ Cancel = False _ Else Cancel = True End Sub
cela affiche juste les etoiles par defaut mais des que l on fait delete on repasse en ecriture normal.
Donc je vais passer par un Userform avec le mode passwordchar.
Desole de vous avoir fais chercher pour rien.

Merci a tous!:king:

05/02/2008, 15h39
tomy7

re

ton idee fonctionne surement mais elle est trop lourde pr moi!

mais merci de ton aide ...:king: