Forums XLPages

Excel & VBA Espace Débutants [résolu] Mot de passe sur bouton

Mot de passe sur bouton
#1
Débutant
Débutant XLPages

Inscription: 14/04/2013

Messages: 9

Système d'exploitation:
PC
Version Excel utilisée:
2007, 2010
Posté le : 21-04-2013 10h45
Bonjour à tous,

j'ai mis un mot de passe sur un bouton, afin d'empêcher les autres utilisateurs d'accéder aux onglets du tableau.

Le problème, c'est que le mot de passe apparait en clair dans l'inputbox.

Comment faire pour qu'il apparaisse masqué? ( ******)

Merci pour votre aide.

Ps : voici le code vba :

Private Sub CommandButton4_Click()
Dim sPass As String
If MsgBox("Etes-vous le concepteur du programme ?", 4 + 32, "Demande du concepteur") = vbYes Then
Else
End
End If
Do
sPass = InputBox("Veuillez saisir le mot de passe")
If sPass = "mon mdp" Then
Exit Do
End If
Loop While 1 = 1
ActiveWindow.DisplayWorkbookTabs = True
End Sub
Hors Ligne
 Rapport   Haut 

Re: Mot de passe sur bouton
#2
JCGL
Accro XLPages

Inscription: 23/05/2007
De Chamrousse

Messages: 309

Système d'exploitation:
PC
Version Excel utilisée:
2013
Posté le : 25-04-2013 20h40
Bonjour à tous,

Avec un code de l'ami Didier

Option Explicit
'---------------------------------------------------------------------------------------
' Auteur    : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com
' Date      : 26/07/2007
' Sujet     : Une InputBox façon "Mot de Passe" ?
'---------------------------------------------------------------------------------------
Public Rep As String

Function InputBoxPwd(rPrompt As String, Optional rTitle As String, Optional rDefault As String) As String
Dim Usf As Object
Dim T As String
Dim N As Byte
    'Création d'un Userform "à la volée"
    Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
    With Usf
        For N = 1 To 4
            'Propriétés du USF
            If N < 4 Then
                .Properties(Choose(N, "Caption", "Height", "Width")) = Choose(N, rTitle, 110, 280)
            End If
            'Création des 4 contrôles et du code associé aux boutons
            With .Designer.Controls.Add("Forms." & Choose(N, "TextBox", "Label", "CommandButton", "CommandButton") & ".1")
                .Move Choose(N, 6, 6, 228, 228), _
                        Choose(N, 64, 6, 6, 30), _
                        Choose(N, 264, 210, 42, 42), _
                        Choose(N, 16, 54, 18, 18)
                Select Case N
                Case 1
                    'Propriétés du TextBox
                    .Value = rDefault
                    .PasswordChar = "*"
                Case Else
                    .Caption = Choose(N - 1, rPrompt, "OK", "Annuler")
                    'Création du code VBA associé aux boutons
                    If N > 2 Then
                        T = "Private Sub " & .Name & "_Click(): "
                        If N = 3 Then
                            .Default = True
                            T = T & "Rep = Me.TextBox1.Text: "
                        End If
                        T = T & "Unload Me: End Sub"
                        With Usf.CodeModule
                            .InsertLines .CountOfLines + 1, T
                        End With
                    End If
                End Select
            End With
        Next N
        'Afficher InputBox fictive
        VBA.UserForms.Add(.Name).Show
        'Retour réponse utilisateur
        InputBoxPwd = Rep
    End With
    'Supprimer l'USF créé
    ThisWorkbook.VBProject.VBComponents.Remove Usf
End Function
  



Et

Private Sub CommandButton4_Click()
Dim sPass As String
If MsgBox("Etes-vous le concepteur du programme ?", 4 + 32, "Demande du concepteur") = vbYes Then
Else
End
End If
Do
sPass = InputBoxPwd("Veuillez saisir le mot de passe")
If sPass = "mon mdp" Then
Exit Do
End If
Loop While 1 = 1
ActiveWindow.DisplayWorkbookTabs = True
End Sub
  

A+ à tous 



Pièce jointe:
xls JC_mDF MdP Etoiles.xls   [ Taille: 76.00 Ko - Téléchargements: 857 ]

Cordialement
Hors Ligne
 Rapport   Haut 

Re: Mot de passe sur bouton
#3
Débutant
Débutant XLPages

Inscription: 14/04/2013

Messages: 9

Système d'exploitation:
PC
Version Excel utilisée:
2007, 2010
Posté le : 27-04-2013 18h48
Bonjour,

Un très grand merci pour cette réponse. C'était vraiment plus compliqué que je ne pensais.

Super chouette ce forum !!

Bien à vous
Hors Ligne
 Rapport   Haut 

Re: Mot de passe sur bouton
#4
papyjac
Débutant XLPages

Inscription: 21/01/2013

Messages: 10

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 12-05-2013 08h04

Bonjour Débutant

 

Si je comprends bien, il y a des onglets autorisé et des onglets interdits pour les utilisateurs

La solution la plus simple est de ne mettre que les onglets autorisés dans le classeur que tu donne aux utilisateurs

Toi, tu disposes du classeur complet, et les utilisateurs disposent d'un classeur réduit

Si cela n'est pas possible : tu masques les onglets interdits et tu protèges la structure du classeur avec mot de passe

 

aucun VBA nécessaire

 

papyjac
Hors Ligne
 Rapport   Haut 

Re: Mot de passe sur bouton
#5
david84
Débutant XLPages

Inscription: 17/02/2013

Messages: 16

Système d'exploitation:
PC
Version Excel utilisée:
2010 version 64 bits
Posté le : 15-05-2013 19h46

Bonsoir Débutant, Jean-Claude, papyjac, le forum,

ci-joint une possibilité à tester et à affiner selon ton besoin (désolé mais je ne trouve pas comment insérer le code dans les balises adéquates) :

Code à placer dans un module :

Option Explicit
Sub Creer_usftemp() 'macro adaptée d'un exemple trouvé sur http://silkyroad.developpez.com/VBA/VisualBasicEditor/
Dim UsfForm As Object
Dim NewB As MSForms.CommandButton
Dim TxtB As MSForms.TextBox
Dim i As Long
Dim UsfName As String

If MsgBox("Etes-vous le concepteur du programme ?", 4 + 32, "Demande du concepteur") = vbYes Then

    Application.VBE.MainWindow.Visible = False
    Set UsfForm = ThisWorkbook.VBProject.VBComponents.Add(3)
    
    With UsfForm
        .Properties("Caption") = "Entrez votre mot de passe"
        .Properties("Width") = 180
        .Properties("Height") = 80
        UsfName = UsfForm.Name
    End With

    Set TxtB = UsfForm.Designer.Controls.Add("Forms.Textbox.1", , True)
    With TxtB
        .Top = 20
        .Height = 20
        .Left = 10
        .Width = 70
        .BorderStyle = fmBorderStyleSingle
        .PasswordChar = "*"
    End With
    
    Set NewB = UsfForm.Designer.Controls.Add("Forms.CommandButton.1")
    
    With NewB
        .Height = 20
        .Width = 70
        .Left = 180 - 80
        .Top = 20
        .Caption = "Valider"
        .Name = "cmdValider"
    End With
    
    With UsfForm.CodeModule
        i = .CountOfLines
        .InsertLines i, "Private Sub cmdValider_Click()": i = i + 1
        .InsertLines i, "Dim mdp As String": i = i + 1
        .InsertLines i, "mdp = ""toto""": i = i + 1
        .InsertLines i, "If Me.TextBox1.Text <> mdp Then": i = i + 1
        .InsertLines i, "MsgBox ""mot de passe incorrect"": ActiveWindow.DisplayWorkbookTabs = False": i = i + 1
        .InsertLines i, "Else": i = i + 1
        .InsertLines i, "ActiveWindow.DisplayWorkbookTabs = True": i = i + 1
        .InsertLines i, "End If": i = i + 1
        .InsertLines i, "UnLoad Me": i = i + 1
        .InsertLines i, "End Sub"
    End With
 
    VBA.UserForms.Add(UsfName).Show
    ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UsfForm
Else
    ActiveWindow.DisplayWorkbookTabs = False
End If
End Sub

 

Et dans le code du bouton de commande :

Private Sub CommandButton1_Click()
Call Creer_usftemp
End Sub

 

A+
Hors Ligne
 Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes