XL 2019 Mot de passe sur une image

telemarrk

XLDnaute Occasionnel
Bonjour à tous,

Je viens vers vous à nouveau, je rencontre un souci en voulant insérer un mot de passe sur une image.
Je m'explique, je vous ai joint un fichier texte avec une image que lorsque l'on clique dessus elle nous renvoie sur la feuille.
J'aimerais au moment de cliquer sur l'image, on me demande de rentrer un mot de passe, je suis allé voir dans la partie "Révision/Protéger la feuille" mais je n'y arrive pas.

Est-ce possible ?

Merci
 

Pièces jointes

  • test.xlsx
    18.3 KB · Affichages: 7

GALOUGALOU

XLDnaute Accro
re telemarrk
avec un userform pour pouvoir masquer la saisie du mot de passe
le mot de passe toto
VB:
Dim mdp As String
Private Sub CommandButton1_Click()
mdp = "toto"
If Me.TextBox1 = mdp Then
Sheets("Feuil2").Select
Unload Me
Else
MsgBox "Mot de passe inexact"
Me.TextBox1 = ""
End If

End Sub
cdt
galougalou
 

Pièces jointes

  • test(1).xlsm
    27.4 KB · Affichages: 11

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Telemarrk, Galougalou,
Ou encore avec un inputbox :
VB:
Sub Graphique2_Cliquer()
    Rep = InputBox("Entrez le mot de passe", "Sécurité")
    If Rep = "toto" Then
        Sheets("Feuil2").Visible = True
        Sheets("Feuil2").Select
    Else
        Sheets("Feuil2").Visible = xlSheetVeryHidden
    End If
End Sub
Ne pas oublier dans ThisWorkbook de masquer la feuille en quittant avec :
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
     Sheets("Feuil2").Visible = xlSheetVeryHidden
End Sub
sinon une fois déprotégée, elle le restera.
 

Pièces jointes

  • test(1) (1).xlsm
    25.3 KB · Affichages: 10

GALOUGALOU

XLDnaute Accro
bonjour sylvanu
re telemarrk
no problème, mais il n'y a pas d'obligation à utiliser un code ou l'autre, vous pouvez les mutualiser. (inclure le principe de la feuille masqué sur le formulaire)

l'avantage d'utiliser un formulaire est de pouvoir masquer le mot de passe à la saisie par l'opérateur. (donc si tout le monde peut le voir, aucun intérêt d'avoir un mot de passe).
ce n'est pas possible avec un inputbox. (a moins d'ulitiser une solution développé par un allemand, j'ai vu ça quelque part, mais je ne sais plus où ?
mais c'est votre projet, vous le développez à votre convenance.
cdt
galougalou
 

patricktoulon

XLDnaute Barbatruc
Bonjour
le truc de l'allemand avec un vrai inputbox c'est celui ci je suppose
je ne suis pas sur d'avoir bien adapté les api en 64 (donc à vérifier)
nikel en 32 bit ;)
dans un module tu met
VB:
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr
Private Declare PtrSafe Function SetWindowsHookExA Lib "user32" (ByVal idHook As LongPtr, ByVal lpfn As Long, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As Long
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare PtrSafe Function GetClassNameA Lib "user32" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else
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 GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookExA Lib "user32" (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 SendDlgItemMessageA Lib "user32" (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 GetClassNameA Lib "user32" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
#End If

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
    RetVal = GetClassNameA(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then
        SendDlgItemMessageA wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
 End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
Dim lngModHwnd As Long, lngThreadID As Long
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandleA(vbNullString)
hHook = SetWindowsHookExA(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function
dans un autre module une sub de test en exemple
VB:
Sub test()
    Dim strPw As String, MDP
    strPw = "toto"
    MDP = InputBoxDK("Entrez le mot de passe...", "Password")
    If MDP <> strPw Then
        If MDP <> "" Then MsgBox "va te faire cuir un oeuf tete de kake!!!!"
    Else: MsgBox "bienvenue"
    End If
End Sub
 

Discussions similaires

Réponses
2
Affichages
113
Réponses
5
Affichages
367
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof