XL 2016 Affecter à un bouton plusieurs possibilité

[phoceenjo]

Bonjour à tous,

Je souhaiterais savoir si il est possible d'affecter plusieurs option a un bouton.

Je m'explique, j'ai créer un code pour que quand on appuie sur un bouton, une image vienne se coller dans une cellule précise. Mon problème est que je souhaiterais que cela ce fasse pour 3 cellules mais uniquement dans la cellule sélectionnée. Pour être plus précis, ces 3 cases seront des zones de signatures pour mes agents cependant en fonction de qui fait les vérifications, ils peuvent être amené a signer une, deux voir les cases, c'est pourquoi je souhaiterais que l'image se colle uniquement dans la cellule sélectionné mais avec un seul bouton de commande.

Pour finir je souhaiterais que ce bouton soit protéger par un mot de passe, pour que seul son détenteur puisse l'utiliser étant donné qu'il s'agit d'une signature.

Voici mon code affecter, pour une personne affecter a un bouton, pour l'instant valable pour une seule cellule au lieu de 3

Sub signature()
'
' signature Macro
'

'
Range("H5:H6").Select
Sheets("Data").Select
ActiveSheet.Shapes.Range(Array("Picture 11")).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Journaliere").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 7.071496063
Selection.ShapeRange.IncrementTop 6.4284251969

End Sub

J’espère que quelqu’un pourra m'aider,

En vous remerciant d'avance,

Cordialement,

 

[Eric KERGRESSE]

Bonjour,

Dans un module standard : Le username est à adapter.

Sub Signature()

     ' Debug.Print Application.UserName
     If Application.UserName = "XXXX" Then
         Sheets("Data").Shapes("Picture 11").Copy
  
         With Sheets("Journaliere")
              .Activate
              .Paste
         End With
     End If

End Sub

Dans le module de l'onglet Journaliere.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

     If Target.Count > 1 Then Exit Sub
      
     If Not Intersect(Target, Range("H5:J5")) Is Nothing Then
        Signature
     End If

End Sub

Un double clic sur la cellule de la place H5:J5 insère la signature dans la cellule active.

S'il y a 3 signataires possibles, il vaudrait mieux ajouter un select case pour copier la signature en fonction du username.

Sub Signature2()

     ' Debug.Print Application.UserName
     Select Case Application.UserName
    
             Case "Agent1"
                   Sheets("Data").Shapes("SignatureAgent1").Copy
             Case "Agent2"
                   Sheets("Data").Shapes("SignatureAgent2").Copy
             Case "Agent3"
                   Sheets("Data").Shapes("SignatureAgent3").Copy
     End Select
     With Sheets("Journaliere")
          .Activate
          .Paste
     End With

End Sub

 

[Cousinhub]

Bonjour,
@Eric
Pour info, Application.Username est modifiable par l'utilisateur dans les options générales d'Office

Il vaut mieux privilégier "Environ("username")" qui retourne l'identifiant de connexion Windows...
Bonne journée

 

[Eric KERGRESSE]

@Cousinhub

Bonjour et merci pour l'info.