Macro: un seul raccourci plusieurs couleurs

Bonjour à tous!

Je fais appel à vos lumières parce que je réalise aujourd'hui que je ne sais pas reproduire une macro que j'ai longtemps eu dans un autre job.

Je donne un exemple:

Avec le raccourci ctrl + j la cellule sélectionnée devenait bleue avec une police blanche. Quand on refaisait ctrl+j, la cellule bleue devenait rouge avec police noire. Refaire ctrl+j la rendait grise, puis jaune, puis de retour à blanche.

De la même manière, ctrl+m mettait en forme la cellule en k€, re-appuyer sur ctrl+m transformait les k€ en Mn€, et ainsi de suite.

De mon côté, étant très novice en macro, je ne sais faire qu'une seule mise en forme par raccourci. Auriez-vous une idée?

Merci beaucoup et excellente journée!

R

Bonjour

Voilà quelques explications :

Tout se passe dans un module standard.

Pour gérer la cellule active il faut utiliser le code :

Application.ActiveCell

Pour remplir d'une couleur la cellule il faut utiliser :

.Interior.ColorIndex = 33 'Couleurs de 1 à 56

Pour la couleur du texte il faut utiliser :

.Font.ColorIndex = 2

Le tout combiner donne :

Sub color()

'bleu= 33
'rouge= 3
'grise= 15
'jaune= 6
'blanche= 2

'noire = 1

With Application.ActiveCell

    If .Interior.ColorIndex = 2 Then .Interior.ColorIndex = 33: .Font.ColorIndex = 2: Exit Sub
    If .Interior.ColorIndex = 33 Then .Interior.ColorIndex = 3: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 3 Then .Interior.ColorIndex = 15: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 15 Then .Interior.ColorIndex = 6: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 6 Then .Interior.ColorIndex = 2: .Font.ColorIndex = 1: Exit Sub

End With

End Sub

A partir de là le plus dur est fait !

Sur Excel, avec ton clavier tu fais ALT+F8, tu sélectionne la macro color et dans "Options' tu peux choir ton raccourcis clavier pour exécuter la macro !

Tu peux voir un exemple ci-dessous, j'ai au préalable remplis toutes les cellules en blanc !

Petit plus, au lieu de remplir en blanc tu peux ne pas remplir les cellules. Il suffis juste de remplacer le bout de code par ça :

J'espère que tout ça te convient

With Application.ActiveCell

    If .Interior.ColorIndex = xlColorIndexNone Then .Interior.ColorIndex = 33: .Font.ColorIndex = 2: Exit Sub
    If .Interior.ColorIndex = 33 Then .Interior.ColorIndex = 3: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 3 Then .Interior.ColorIndex = 15: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 15 Then .Interior.ColorIndex = 6: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 6 Then .Interior.ColorIndex = xlColorIndexNone: .Font.ColorIndex = 1: Exit Sub

End With

Merci beaucoup @GGautier, c'est parfait ! Je savais que c'était un if-then mais je ne savais pas en écrire plusieurs à la fois! Ca marche parfaitement bien! je vais pouvoir reprendre la même construction pour les différentes mises en forme dont j'ai besoin.

Encore merci, pour la réponse comme pour la réactivité!

Re : De rien, cependant je n'est pas encore répondu à la deuxième partie de ton problème concernant les formats de nombre. Quelles format souhaites-tu avoir ? Tu veux convertir par exemple 10 000€ en 10 K€ ?

Re : Voilà le fichier avec changement de format avec CTRL+m En espérant que cela va te convenir

Note : j'ai aussi modifié légèrement le code pour les couleurs qui fonctionne dans n'importe quelle situation

Bonjour bonjour,

Merci pour votre réactivité! j'ai pris le temps de tout tester, et sans suspense, tout marche! Juste 2 petites questions complémentaires:

1) avec la solution actuelle, si je sélectionne plusieurs cellules et que je fais mon raccourci seule la première est mise en forme. Serait-il possible que toutes les cellules sélectionnées soient mises en forme?

Je vous mets ci dessous les 2 codes que j'utilise, vu que j'ai modifié quelques éléments.

2) j'ai repris la même construction pour faire apparaitre et disparaitre le grillage, ça marche au top. Mais j'ai essayé de le faire pour grouper des lignes et les dégrouper avec le même raccourci, et là ça ne marche pas. Savez vous ce qui bug dans mon code?

Sub Grouper()
'
' Grouper Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+G
'
    With Application.ActiveCell
    If Selection.Rows.Group Then Selection.Rows.Ungroup: Exit Sub
    Selection.Rows.Group

    End With

End Sub

Et voici les codes pour la question 1)

Sub color()

'Rouge = 18
'Jaune = 6
'grise= 15
'Vert = 43
'blanche= 2

'noire = 1

With Application.ActiveCell
    If .Interior.ColorIndex = 18 Then .Interior.ColorIndex = 6: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 6 Then .Interior.ColorIndex = 15: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 15 Then .Interior.ColorIndex = 43: .Font.ColorIndex = 1: Exit Sub
    If .Interior.ColorIndex = 43 Then .Interior.ColorIndex = xlColorIndexNone: .Font.ColorIndex = 1: Exit Sub
    .Interior.ColorIndex = 18: .Font.ColorIndex = 2
End With

End Sub

et pour la mise en forme en k puis k€ puis Mn puis Mn€

Sub mefk()

'Passe en écarté puis en K puis K€ puis en Mn puis en Mn€

With Application.ActiveCell
    If .NumberFormat = "#,##0.0" Then .NumberFormat = "#,##0.0,"" K""": Exit Sub
    If .NumberFormat = "#,##0.0,"" K""" Then .NumberFormat = "#,##0.0,"" K€""": Exit Sub
    If .NumberFormat = "#,##0.0,"" K€""" Then .NumberFormat = "#,##0.00,,"" Mn""": Exit Sub
    If .NumberFormat = "#,##0.0,,"" Mn""" Then .NumberFormat = "#,##0.0,,"" Mn€""": Exit Sub
    If .NumberFormat = "#,##0.0,,"" Mn€""" Then .NumberFormat = "#,##0.0": Exit Sub
    .NumberFormat = "#,##0.0"
End With

End Sub

Re Alors essaye de remplacer ActiveCell par Selection pour pouvoir colorier les cellules sélectionnées. Je revient bientôt (je l'espère) pour répondre à la deuxième question le temps que je fasse des tests

EDIT 16:00 Le code est plus simple que ce que je croyais Voilà le code :

Sub groupe()

If ActiveCell.MergeArea.Count > 1 Then Selection.UnMerge Else Selection.Merge

End Sub

Je reviens sur mon précédent poste. Le dernier code que je t'ai donné permet de fusionner des cellules.

Code pour fusionner des cellules :

Sub Fusionner_Cellues()

If ActiveCell.MergeArea.Count > 1 Then Selection.UnMerge Else Selection.Merge

End Sub

Code pour grouper des lignes :

Sub Grouper_Lignes()

If Selection.EntireRow.OutlineLevel > 1 Then Selection.Ungroup Else Selection.Group
'EntireColumn pour les colonnes
End Sub