Changement de mise en forme d'une cellule par simple clic

Bonjour Bernard

Il faut passer par une macro en VBA
Postes un exemple de ton fichier sur le site cjoint.com, fais créer un lien, copies le et reviens le coller ici dans un prochain message; on verra ce qu'il est possible de faire

Cdlmnt
Via

Bonjour,

Code à placer dans le module de la feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cel As Range
Dim Compteur As Long
    On Error GoTo fin
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("A1:AJ100")) Is Nothing Then
        For Each Cel In Range("A1:AJ100")
            If Cel.Interior.ColorIndex = 33 Then Compteur = Compteur + 1
        Next Cel
        If Compteur < 4 And Target.Value <> "" And Target.Interior.ColorIndex = xlNone Then
            Target.Interior.ColorIndex = 33
            Target.Font.Bold = True
            Target.Font.ThemeColor = xlThemeColorDark1
        ElseIf Target.Interior.ColorIndex = 33 Then
            Target.Interior.ColorIndex = xlNone
            Target.Font.Bold = False
            Target.Font.ColorIndex = xlAutomatic
        End If
    End If
fin:
End Sub

A+

Bonjour Gyrus

Merci pour cette réponse qui fonctionne très bien.

Après utilisation je souhaiterais qu'elle puisse être complétée de la manière suivante : lorsque le fond d'une cellule est coloré en bleu son contenu est copié dans la 1ère cellule vide de la plage K1:K4.

A +

Bernard

Bonjour,

Code adapté :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cel As Range, C As Range
Dim Compteur As Long
    On Error GoTo fin
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("A1:AJ100")) Is Nothing Then
        For Each Cel In Range("A1:AJ100")
            If Cel.Interior.ColorIndex = 33 Then Compteur = Compteur + 1
        Next Cel
        If Compteur < 4 And Target.Value <> "" And Target.Interior.ColorIndex = xlNone Then
            Target.Interior.ColorIndex = 33
            Target.Font.Bold = True
            Range("K4") = Target.Value
        ElseIf Target.Interior.ColorIndex = 33 Then
            Target.Interior.ColorIndex = xlNone
            Target.Font.Bold = False
            Target.Font.ColorIndex = xlAutomatic
            Range("K1:K4").Find(Target, , xlValues, xlWhole).ClearContents
        End If
        Range("K1:K4").Sort Key1:=Range("K1"), Header:=xlNo
    End If
fin:

End Sub

Attention toutefois car la plage K1:K3 faisant partie de la plage A1:AJ100, le traitement s'applique également à ces 4 cellules (ça se mord la queue !)

A+

Bonjour,

Il subsiste le problème suivant : seule la dernière cellule sur laquelle il a été cliqué est copiée dans la 1ere cellule vide de la plage K1:K4.

K1:K4 est en bordure de A1:AJ100 sans en faire partie.

Bernard14

Bonjour,

Je n'ai pas compris ton souci.
Voici le fonctionnement :
La copie se fait systématiquement dans la cellule K4. Ensuite, les données de la plage K1:K4 sont triées. La cellule K4 devient ainsi à nouveau libre pour une nouvelle copie jusqu'à ce que la plage entière soit renseignée.
De même, lorsqu'une cellule est désélectionnée la valeur est supprimée de la plage K1:K4 et les données sont triées, ce qui libère K4, puis K3, etc.

La seule particularité, c'est que l'ordre des données dans K1:K4 ne correspond pas à l'ordre de sélection, le tri se faisant suivant l'ordre alphabétique.

De plus, je te confirme que la plage K1:K4 fait partie de A1:AJ100, bien qu'elle soit en bordure.
C'est important car si tu cliques sur une cellule de cette plage, tu verras un effet indésiré.

A+

Bonjour

Le problème est résolu. Les numéros s'affichent comme souhaité.

Est-il possible d'apporter une amélioration qui serait la suivante : quand il est passé sans cliquer sur les cellules ou quand il est cliqué sur elles elles changent de couleur si le nombre de cellules à fond bleu n'est pas atteint. Est-il possible que le changement ne se fasse que si uniquement un clic sur cette cellule a été effectué?

Merci

A plus