Modifier et copier une cellule par clic sur elle

Bonjour,

Je fais appel à votre savoir-faire afin de réaliser la macro suivante, où 10 cellules peuvent être cliquée au maximum dans la plage A1:BL1 .

Le fait de cliquer sur une cellule fait changer sa mise en forme :

- le fond passe en couleur bleu ciel
- la police passe en couleur blanche

.... et le contenu de la cellule cliquée est copié :

- pour la 1ere cellule cliquée en W20
- pour la 2ème en Y20
- pour la 3ème en AA20
- pour la 4ème en AC20
- pour la 5ème en AE20
- pour la 6ème en AG20
- pour la 7ème en AI20
- pour la 8ème en AK20
- pour la 9ème en AM20
- pour la 10ème en AO20

Merci

1 réponse

  1. Bonsoir

    Possible par double-clic dans les cellules

    Il faut comptabiliser les clics quelque part, dans la macro ci dessous on le fait dans la cellule BP1 de la feuille (à modifier si nécessaire)

    Macro à coller dans le worksheet de la feuille concernée (ALT F11 pour ouvrir editeur - double cliquer sur nom de la feuille dans arborescence, copier-coller macro dans la page blanche et fermer l'éditeur
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row > 1 Or Target.Column > 64 Then Exit Sub
    If Range("BP1") = 10 Then MsgBox "10 double-clics déjà effectués": Exit Sub
    Range("BP1") = Range("BP1") + 1
    col = 23 + 2 * (Range("BP1") - 1)
    Cells(20, col) = Target.Value
    Cells(Target.Row, Target.Column).Select
    Selection.Interior.Color = 15773696
    Selection.Font.ThemeColor = xlThemeColorDark1
    End Sub


    Cdlmnt
    Via
    0
    1. Bonjour via55

      Merci de votre réponse.

      Je souhaiterai que la macro s'exécute par simple clic.
      Est-il possible de réaliser les opérations suivantes :

      Clic sur A1: si le fond de la cellule est blanc et si
      le nombre de cellules à fond bleu ciel de la plage A1:A20 est inférieur à 10
      alors :
      - la valeur affichée dans la cellule A1 est copiée dans la 1ère cellule vide de la plage
      B1:B20
      - la macro "BleucielA1" est appelée et modifie la mise en forme de A1

      Clic sur A1 : si le fond de la cellule est bleu ciel
      alors :
      - le contenu de la cellule de la plage B1:B20 égal à A1 est effacé
      - la macro "BlancA1" est appelée et modifie la mise en forme de A1

      Cordialement
      0
    2. @Denis14Bonjour Denis

      Il est inutile de mener la discussion sur 2 fils différents !
      Alors en adaptant la macro que Gyrus, que je salue au passage, t'avait fourni sur l'autre fil
      Option Explicit
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Dim n As Integer, w As Integer, lg As Integer, ligB As Integer
      If Target.Count > 1 Then Exit Sub
      'si cellule vide ou dans une autre colonne que la A ou ligne >20 ne rien faire
          If Target.Value = "" Or Target.Column > 1 Or Target.Row > 20 Then Exit Sub
          
      ' si cellule blanche
          If Target.Interior.Pattern = xlNone Then
          ' boucle sur 20 lignes de col A et comptabilise cellules bleues
          For n = 1 To 20
          If Range("A" & n).Interior.Color = 15773696 Then w = w + 1
          Next
              ' si nombre cellules bleues inférieur à 9
              If w < 10 Then
                  ' boucle sur les 20 lignes col B à partir de la fin pour trouver 1ere cellule vide
                      For lg = 20 To 1 Step -1
                      If Range("B" & lg).Value = "" Then ligB = lg
                      Next
                  ' execution macro bleu avec la cellule du clic comme cellule source et la cellule vide comme cellule cible
                  MiseEnFormeBleu Target, Range("B" & ligB)
              End If
          Exit Sub
          End If
          
       ' sinon (cas de cellule bleue)
               ' recherche ligne en col B ou se trouve la même valeur
              ligB = Columns(2).Find(Target.Value, , , , xlByColumns, xlPrevious).Row
              ' puis execution macro bleu avec la cellule du clic comme cellule source et la cellule en B comme cellule cible
              MiseEnFormeBlanc Target, Range("B" & ligB)
             
      End Sub
      Sub MiseEnFormeBleu(CelS As Range, CelC As Range)
          With CelS
         
                  'le fond de la cellule passe en couleur bleu ciel
                  .Interior.Color = 15773696
                  'la police passe en couleur blanche.
                  .Font.ThemeColor = xlThemeColorDark1
                  'Copie en col B
                  CelC = .Value
                  End With
                  
              End Sub
       Sub MiseEnFormeBlanc(CelS As Range, CelC As Range)
              
               With CelS
                  'supppression du remplissage
                  .Interior.Pattern = xlNone
                  'la police passe en couleur automatique.
                  .Font.ColorIndex = xlAutomatic
                  'Effacement en col B
                  CelC.ClearContents
              End With
      End Sub
      


      Cdlmnt
      Via
      0
    3. @via55Bonjour via55

      La macro créée suite à votre réponse ne s'exécute pas et fait se déclencher le message suivant : " Erreur de compilation. Instruction incorrecte dans une procédure". Ou ai-je commis une ou des erreurs ?

      Merci
      Denis 14

      Sub Macro1()

      ' Macro1 Macro
      ' Macro enregistrée le 31/10/2015 par Denis
      '

      Option Explicit
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Dim n As Integer, w As Integer, lg As Integer, ligB As Integer
      If Target.Count > 1 Then Exit Sub
      If Target.Value = "" Or Target.Column > 1 Or Target.Row > 20 Then Exit Sub
      If Target.Interior.Pattern = xlNone Then
      For n = 1 To 20
      If Range("A" & n).Interior.Color = 15773696 Then w = w + 1
      Next
      If w < 10 Then
      For lg = 20 To 1 Step -1
      If Range("B" & lg).Value = "" Then ligB = lg
      Next
      MiseEnFormeBleu Target, Range("B" & ligB)
      End If
      Exit Sub
      End If
      ligB = Columns(2).Find(Target.Value, , , , xlByColumns, xlPrevious).Row
      MiseEnFormeBlanc Target, Range("B" & ligB)

      End Sub
      Sub MiseEnFormeBleu(CelS As Range, CelC As Range)
      With CelS

      .Interior.Color = 15773696
      .Font.ThemeColor = xlThemeColorDark1
      CelC = .Value
      End With
      End Sub
      Sub MiseEnFormeBlanc(CelS As Range, CelC As Range)

      With CelS
      .Interior.Pattern = xlNone
      .Font.ColorIndex = xlAutomatic
      CelC.ClearContents
      End With
      End Sub
      0
    4. @Denis14Bonjour Denis

      Enlève la ligne du début qui n'appartient pas à la macro et qui doivent provoquer l'erreur,

      Sub Macro1()

      ' Macro1 Macro
      ' Macro enregistrée le 31/10/2015 par Denis

      Cdlmnt
      Via
      '
      0