Discussion :

[tomy7]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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!

[zebulon2212]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[tomy7]

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.

[cafeine]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

inputboxPassWord("Entre le mot de passe")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Singular]

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.

[fred65200]

bonsoir à tous

il me semble que tu peux faire tout simplement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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).

[ouskel'n'or]

USF Mot de passe.zip
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)

[fred65200]

bonsoir Bigalo,


ç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.