Microsoft 365 Macro vba excel

[souhaib ad]

bonjour
je besoin d'aide
Private Sub CommandButton7_Click()
Dim userCode As String
userCode = InputBox("Veuillez entrer le code pour déverrouiller la feuille:", "Code requis")
' Vérifier si le code entré est correct
If userCode = "BARTIB@1234" Then
' Si le code est correct, déverrouiller la feuille
ThisWorkbook.Unprotect
ThisWorkbook.Application.Visible = True
Unload Me Else
' Si le code est incorrect, afficher un message d'erreur
MsgBox "Code incorrect. Veuillez réessayer.", vbExclamation
End If
End Sub
MODIFIER CE MACRO QUAND JE SAISI LE MOT DE PASSE IL SAISI SOUS FORME D'ETOILE

 

[patricktoulon]

re
Bonjour
ouh !! la lala
tu t'engage dans le hooking d'un inputbox
c'est pas pour les baby vba ça

bien que je pige mal ton truc puisque si tu a protégé le classeur c'est l'input de l'application qui devrait s'afficher

mais bon si tu insiste
dans un module standard

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

et ton event click

Private Sub CommandButton7_Click()
Dim userCode As String
userCode = InputBoxDK("Entrez le mot de passe...", "Password")
' Vérifier si le code entré est correct
If userCode = "BARTIB@1234" Then
' Si le code est correct, déverrouiller la feuille
ThisWorkbook.Unprotect
'ThisWorkbook.Application.Visible = True
Application.Visible = True
Unload Me
Else
' Si le code est incorrect, afficher un message d'erreur
MsgBox "Code incorrect. Veuillez réessayer.", vbExclamation
End If
End Sub

comme ça juste en passant
il faudra m'expliquer de puis quand l'application est un membre de thisworkbook

ThisWorkbook.Application.Visible = True'!!!!??????????????

il faudra aussi m'expliquer comment tu en est arrivé a démarrer a partir d'un userform pour demander un inputbox MDP

 

[sylvanu]

Bonjour Souhaib ad, Patrick,
Ce serait plus simple de passer par un userform, il a une propriété Passwordchar qui est fait pour.
Un essai en PJ avec dans Thisworkbook :

Private Sub Workbook_Open()
Sheets("Feuil1").Visible = True
Application.ScreenUpdating = False
For Each F In Worksheets
    If F.Name <> "Feuil1" Then Sheets(F.Name).Visible = xlVeryHidden
Next F
Application.ScreenUpdating = True
UserForm1.Show
End Sub

et dans "ok" de l'userform :

Private Sub b_ok_Click()
If Me.TextBox1 = "BARTIB@1234" Then
    Application.ScreenUpdating = False
    For Each F In Worksheets
        If F.Name <> "Feuil1" Then Sheets(F.Name).Visible = True
    Next F
    Sheets("Feuil1").Visible = xlVeryHidden
    Unload UserForm1
Else
    Me.TextBox1 = ""
    MsgBox "Mot de passe érroné."
End If
End Sub

MDP : BARTIB@1234

 

[patricktoulon]

re
ce n'est pas un inputbox que tu a fait @sylvanu mais un applicatif
un imputbox est une fonction affichant une fenêtre avec un input et au bouton valider ou annuler il renvoie la réponse il ne l'applique pas
voici un exemple de comportement d'un inputbox
il renvoie false ou cancel ou le mot de passe tapé
le code du userform

Public Property Get MdP(Optional message$ = "Tapez une valeur", Optional titre$ = "inputboxUF")
    With inputBoxUF
        .Caption = titre: .ctmessage = message: .Show
        MdP = IIf(.txtMDP = "Faux", False, txtMDP)
        Unload inputBoxUF
    End With
End Property

Private Sub btcancel_Click(): txtMDP = "Faux": Me.Hide: End Sub
Private Sub btValider_Click(): Me.Hide: End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True: btcancel_Click
End Sub

et je reprend ton exemple à l'open

Private Sub Workbook_Open()
    Sheets("Feuil1").Visible = True
    Application.ScreenUpdating = False
    For Each F In Worksheets
        If F.Name <> "Feuil1" Then Sheets(F.Name).Visible = xlVeryHidden
    Next F

re:
    Dim MdP, X
    MdP = inputBoxUF.MdP("veuillez entrer votre mot de passe", "Authentification")
    Select Case True
    Case CStr(MdP) = "BARTIB@1234"
    MsgBox "Bienvenue": démasquage
    Case CStr(MdP) = "Faux"
        MsgBox "Authentification annulée"
        With Application: .DisplayAlerts = False: .Quit: End With
    Case CStr(MdP) <> "BARTIB@1234"
        X = MsgBox("Mot de passe invalide" & vbCrLf & "Echec de l'authentification" & vbCrLf & "Voulez vous éssayer  à  nouveau", vbYesNo)
        If X = vbYes Then
            GoTo re
        Else
            With Application: .DisplayAlerts = False: .Quit: End With
        End If
    End Select
End Sub

la oui on a le vrai comportement

 

[sylvanu]

Bonsoir Patrick,
Evidemment qu'un userform n'est pas un inputbox.
D'où ma remarque préliminaire:

Ce serait plus simple de passer par un userform,

La seule demande que j'ai lu est :

MODIFIER CE MACRO QUAND JE SAISI LE MOT DE PASSE IL SAISI SOUS FORME D'ETOILE

 

[patricktoulon]

re
essaie le mien c'est bien un inputbox à part entière
tu devrais vite piger comment ça marche
pour toi ça devrait pas être difficile

 

[patricktoulon]

mais je tiens a revenir quand même sur ce que j'ai dit plus haut
sur le fait qu'il n'y a pas besoin d'input ou de vba ou de quoi que ce soit
pour mettre un mot de passe à un classeur

ca marche très bien tout seul