[Excel 2007] saisir mot de passe dans le ruban et l'afficher sous forme d'astérisques

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

MichelXld

XLDnaute Barbatruc
Parmi les contrôles du ruban, il n'existe pas de propriéte passwordChar comme pour les textBox mais une solution de remplacement consiste à sélectionner les caractères depuis une galerie puis à les afficher sous forme d'astérisques dans une étiquette.

getLabel.jpg


Dans le fichier xml de personnalisation :

Code:
<customUI xmlns="" onLoad="objRuban"> 
 
  <ribbon>
    <tabs>
      <tab id="Essai" label="Essai" >
        <group id="MdP" label="Mot de passe">
 
  <gallery id="gallery01" 
   size="normal"
   imageMso="CalculateNow" 
   label="Saisissez le mot de passe:"
   columns="6" 
   rows="6"
   getItemCount="NbCaracteres"
   showItemLabel="true"
   getItemLabel="LabelCaractere"
   screentip="Sélectionnez les caractéres dans la galerie, 
    puis validez le mot de passe."
   onAction="SelectCaractere" > 
 
   <button id="Bt02" label="Effacer la saisie." 
    imageMso="ClearMenu" onAction="EffaceContenuLabel"/> 
 
  </gallery> 
 
  <box id="Box01" boxStyle="horizontal">
   <labelControl id="LC01" getLabel="ContenuLabel" /> 
 
  </box> 
 
  <button id="Bt01" imageMso="FileStartWorkflow" size="normal" 
   label="Validez le mot de passe" visible="true" onAction="ValidationMdP" /> 
 
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>


Dans le module objet du classeur :

Code:
Option Explicit
 
'Définit les caractère utilisables pour la saisie du mot de passe
Private Sub Workbook_Open()
    Tableau = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", _
        "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", _
        "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
End Sub


Dans un module standard du classeur :

Code:
Option Explicit
Option Base 1
 
Public Cible As String
Public MonRuban As IRibbonUI
Public Tableau As Variant
 
 
 
'Callback for customUI.onLoad
'Définit l'objet ruban
Sub objRuban(ribbon As IRibbonUI)
    Set MonRuban = ribbon
End Sub
 
 
'Callback for gallery01 getItemCount
'Définit le nombre d'élément dans la galerie
Sub NbCaracteres(control As IRibbonControl, ByRef returnedVal)
    returnedVal = UBound(Tableau) + 1
End Sub
 
 
'Callback for gallery01 getItemLabel
'Création des éléments dans la galerie
Sub LabelCaractere(control As IRibbonControl, index As Integer, ByRef returnedVal)
    returnedVal = Tableau(index)
End Sub
 
 
'Callback for gallery01 onAction
'Met à jour le label après avoir sélectionné un caractère dans dans la galerie
Sub SelectCaractere(control As IRibbonControl, id As String, index As Integer)
    Cible = Cible & Tableau(index)
    MonRuban.InvalidateControl "LC01"
End Sub
 
 
'Callback for LC01 getLabel
'Affiche des asteriques dans le label en lieu et place des caractères
Sub ContenuLabel(control As IRibbonControl, ByRef returnedVal)
    returnedVal = Application.WorksheetFunction.Rept("*", Len(Cible))
End Sub
 
 
'Callback for Bt01 onAction
'Validaton du mot de place
Sub ValidationMdP(control As IRibbonControl)
    MsgBox "Confirmation du mot de passe : (" & Cible & ")"
 
    Cible = ""
    MonRuban.InvalidateControl "LC01"
End Sub
 
 
'Callback for Bt02 onAction
'réinitialisation: Efface le contenu du label en cas d'erreur
'de saisie.
Sub EffaceContenuLabel(control As IRibbonControl)
    Cible = ""
    MonRuban.InvalidateControl "LC01"
End Sub


Pour plus d'infos sur la personnalisation du ruban:
La personnalisation du ruban sous Excel 2007 - Club d'entraide des développeurs francophones

Personnalisation du ruban: Les fonctions d'appel CallBacks - Club d'entraide des développeurs francophones
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour