Bouton lance macro avec mot de passe

[FanExcel]

Bonjour,

Je travaille sur un nouveau fichier dans lequel des cellules sont protégées et des feuilles cachées, ce fichier étant destiné à des utilisateurs devant y effectuer de la saisie.

Au retour de ce fichier, je voudrais pouvoir lancer une macro qui déprotège les feuilles et une macro qui rende toutes les feuilles visibles.
A l'inverse, avant de renvoyer le fichier aux utilisateurs je souhaite re-proteger et masquer certaines feuilles;

Les macros sont écrites et associées à des boutons.
Le problème est que tout le monde peut les lancer à partir des boutons alors que je voudrais que seuls mes collaborateurs puissent lancer ces macros et que lorsqu'on clique sur le bouton il y ait un mot de passe qui permette de lancer la macro.

J'espère être assez claire car je ne peux pas envoyer de fichier c'est bcp trop gros

D'avance merci🙂
H.

 

[alex67800]

Re : Bouton lance macro avec mot de passe

Bonjour FanExcel, le forum,

le problème ne viendrait-il pas de là:

Sub okgo()
'Ici mettre ton code
MsgBox "accès administrateur", vbExclamation
[COLOR="red"]AfficherFeuilles[/COLOR]
[COLOR="Red"]DProtecFeuilles0[/COLOR]
Feuil1.CommandButton2.Visible = True
End Sub

dans ton module3
Tu appel la macro affiche feuille avant de déprotéger!!
J'ai fais un essai en mettant DProtectFeuilles0 avant AfficherFeuilles ça a l'air de fonctionner!!

A te lire!

 

[FanExcel]

Re : Bouton lance macro avec mot de passe

dans ton module3
Tu appel la macro affiche feuille avant de déprotéger!!
J'ai fais un essai en mettant DProtectFeuilles0 avant AfficherFeuilles ça a l'air de fonctionner!!

Bonjour Alex et merci.
Bonjour le forum
Effectivement ça a (plus que) l'air de fonctionner.🙂
Je le teste dans une des maquettes et je donne des nouvelles et le bout de fichier corrigé au cas où il pourrait être utile à un forumeur

A bientôt 🙂

 

[FanExcel]

Re : Bouton lance macro avec mot de passe

Oui, ça fonctionne.🙂

Alors, encore merci 🙂 et je joins le fichier test corrigé.
Finalement, c'était l'ordre des instructions qui n'était pas bon 😀

A bientôt !!

 

[kllmoon]

Re : Bouton lance macro avec mot de passe

salut, je trouvais le sujet intéressant et je voulais partager un code que j'ai trouvé sur développez.com

C'est une fonction qui permet de crypter et décrypter suivant la méthode Vigenère et qui peut donc permettre l'utilisation de mots de passe qu'on insère facilement dans notre code. Dans l'exemple ici, le mot de passe est "BONJOUR" (avec les guillemets). C'est loin d'être infaillible de la façon que j'ai organisé le bouton mais j'oublie comment appeler une fonction en vba 😕

Option Explicit
' Clé de cryptage
Private Const CLEF As String = "A45RGT5FER6745GHTOGFSDOPK56453235K"
' Nombre d'itérations de la fonction maximum
Private Const NBROTATIONSMAX       As Long = 13
' Valeurs possibles
Private Const gValues = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 
Public Function Crypter(ByVal pChaine As String)
'---------------------------------------------------------------------------------------
' Procedure : Crypter
' Créée le  : lundi 18 juil 2005 18:51
' Auteur    : Maxence HUBICHE
' Site      : http://mhubiche.developpez.com
' Objet     : Crypter la chaîne en fonction d'une clef et de la méthode
'               de Vigenère
' Adapaté par :
' Thierry GASPERMENT (Arkham46) Cryptage avec valeurs possibles
'---------------------------------------------------------------------------------------
' Le chaine pChaine doit être composée de caractères présents dans gValues
'---------------------------------------------------------------------------------------
 
    Dim sLettres    As String
    Dim lCompteur   As Long
    Dim lLongueur   As Long
    Dim lBoucle     As Long
    Dim lLenValues  As Long
    'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
    lLongueur = Len(pChaine)
    sLettres = String(lLongueur, Chr(0))
    lLenValues = Len(gValues)
    'Boucler en fonction du nombre de rotations attendues
    For lBoucle = 1 To NBROTATIONSMAX
        'boucler pour chaque caractère de la chaîne initiale
        For lCompteur = 1 To lLongueur
            If InStr(gValues, Mid(pChaine, lCompteur, 1)) <> 0 Then
                Mid(sLettres, lCompteur, 1) = Mid(gValues, (InStr(gValues, Mid(pChaine, lCompteur, 1)) + _
                    (InStr(gValues, Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)) * lLongueur)) Mod lLenValues + 1)
            Else
                Mid(sLettres, lCompteur, 1) = Mid(pChaine, lCompteur, 1)
            End If
        'recommencer
        Next
        'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
        pChaine = sLettres
    'Nouvelle itération
    Next
    'Renvoyer le résultat final
    Crypter = sLettres
End Function
 
Public Function decrypter(ByVal pChaine As String)
'---------------------------------------------------------------------------------------
' Procedure : Decrypter
' Créée le  : 25 juin 2005 18:51
' Auteur    : Thierry GASPERMENT
' Site      : http://arkham46.developpez.com
' Objet     : Decrypter la chaîne en fonction d'une clef et de la méthode
'               de Vigenère
'---------------------------------------------------------------------------------------
'
    Dim sLettres    As String
    Dim lCompteur   As Long
    Dim lLongueur   As Long
    Dim lBoucle     As Long
    Dim lLenValues  As Long
    Dim lPosition   As Long
    'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
    lLongueur = Len(pChaine)
    sLettres = String(lLongueur, Chr(0))
    lLenValues = Len(gValues)
    'Boucler en fonction du nombre de rotations attendues
    For lBoucle = 1 To NBROTATIONSMAX
        'boucler pour chaque caractère de la chaîne initiale
        For lCompteur = 1 To lLongueur
            If InStr(gValues, Mid(pChaine, lCompteur, 1)) <> 0 Then
                lPosition = ((InStr(gValues, Mid(pChaine, lCompteur, 1)) + lLenValues - 1) - ((InStr(gValues, Mid(CLEF, (lCompteur Mod Len(CLEF) + 1), 1)) * lLongueur) Mod lLenValues + 1)) Mod lLenValues + 1
                Mid(sLettres, lCompteur, 1) = Mid(gValues, (lPosition))
            Else
                Mid(sLettres, lCompteur, 1) = Mid(pChaine, lCompteur, 1)
            End If
        'recommencer
        Next
        'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
        pChaine = sLettres
    'Nouvelle itération
    Next
    'Renvoyer le résultat final
    decrypter = sLettres
End Function


Private Sub CommandButton1_Click()
Dim variable As String
On Error GoTo Errorhandler
variable = "B7SVVDK"
Range("B600").Value = "=A600"
[A600].Value = "=crypter(" & inputbox("écrivez votre mot de passe en majuscules et entre guillemets") & ")"
If Range("B600").Value = variable Then MsgBox ("mot de passe bon")
If [B600].Value <> "B7SVVDK" Then
MsgBox ("mot de passe faux")
[A600].Delete
Exit Sub
End If
[A600].Delete
 Exit Sub
Errorhandler:
 MsgBox ("il y a eu erreur veuillez recommencer")
 [A600].Delete
End Sub