Discussion :

[retraite83]

bonjour,

j'ai 12 feuilles pour les 12 mois de l'année, avec en abscisse les jours et en ordonnée des noms.

Quand je tape un "C" dans un jour (une cellule) je veux qu'elle devienne rouge. J'ai résolu le problème par une mise en forme conditionnelle très simple, mais je préférerai que cela se fasse par un simple clic (voir un double si pas possible) sur la cellule sans avoir à taper le "C"

Je pense qu'il faille envisager une macro pour cela. Et comment affecter une macro à 365 cellules (pour chaque jour du calendrier de chaque feuille) ?

[halaster08]

Bonjour,

Intéresse-toi aux macros évènementielles :https://silkyroad.developpez.com/VBA/EvenementsFeuille/
Il y a en a pour le double clic, le clic droit, pas pour le simple clic mais tu peux passer par selection_change.
En ajoutant une condition sur la position dans ton calendrier du Target tu peux t'assurer que seul tes 365 cellules soient impactées.

[patricktoulon]

bonjour retraité

cela pourrait eventuellement t'intéresser


je l'ai fait vite fait il peu etre amelioré

[retraite83]

Merci halaster08 pour les macros événementielles, je ne connaissais pas

bonjour Patrick, je vais regarder ton message de près


je vais regarder tout ça,

j'ai pu faire ça avec ma 1ere macro événementielle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Plage As Range
Dim x As Integer
Dim Cell As String
 
x = ActiveCell.Interior.ColorIndex
Cell = ActiveCell.Address
 
Set Plage = Range("C6:AF11")
    If Range(Cell).Interior.ColorIndex = 3 Then
        Range(Cell).Interior.ColorIndex = 2
    Exit Sub
    End If
    If Application.Intersect(Target, Plage) Is Nothing Then
    Else
        Range(Cell).Interior.ColorIndex = 3
    End If
End Sub

le problème est que je dois sortir de la rubrique pour changer une deuxième fois de couleur :

- clic : la cellule devient bien rouge mais ne redevient pas blanche au 2eme clic puisque je sors de la macro…
- en allant sur une autre cellule et en revenant sur la cellule d'origine elle redevient bien blanche si rouge au départ

Comment faire ça sans changer de cellule?

[patricktoulon]

re ce que tu demande est simple
dans ta condition intersect tu met

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'if condition intersect
Cancel = True
With Target: .Interior.ColorIndex = IIf(.Interior.ColorIndex = 3, 2, 3): End With
'end if 
End Sub

[halaster08]

le problème est que je dois sortir de la rubrique pour changer une deuxième fois de couleur :
Comment faire ça sans changer de cellule?

C'est le problème avec l'utilisation de selection_change qui comme son nom l'indique ne s'active que si tu change la sélection (donc ne s'applique qu'un fois si tu clic plusieurs fois de suite sur la même cellule.
Comme il n'y a pas d'évènement clic gauche, soit tu utilise selection_change malgré ce défaut, soit tu passes par un clic droit ou un double clic

[retraite83]

Merci, !

j'ai essayé autre chose aussi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("C6:AF11")) Is Nothing Then
    coul = Target.Interior.ColorIndex
    Select Case coul
    Case 2
    Target.Interior.ColorIndex = 3   ' après blanc --> rouge
    Case 3
    Target.Interior.ColorIndex = 5   ' après rouge --> bleu
    Case 5
    Target.Interior.ColorIndex = 4   ' après bleu  -> vert
    Case 4
    Target.Interior.ColorIndex = 2   ' après vert boucle sur blanc
    Case Else
    Target.Interior.ColorIndex = 2   ' Après autre couleur  --> blanc
    End Select
End If
End Sub

cela marche très bien

en élargissant les couleurs à toutes les couleurs RGB :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("C6:AF11")) Is Nothing Then
    coul = Target.Interior.ColorIndex
    Select Case coul
    Case Interior.Color = RGB(255, 255, 255)
    Target.Interior.Color = RGB(255, 0, 0)   ' après blanc --> rouge
    Case Interior.Color = RGB(255, 0, 0)
    Target.Interior.Color = RGB(51, 51, 255)   ' après rouge --> bleu
    Case Interior.Color = RGB(51, 51, 255)
    Target.Interior.Color = RGB(51, 204, 51)   ' après bleu  -> vert
    Case Interior.Color = RGB(51, 204, 51)
    Target.Interior.Color = RGB(255, 255, 255)   ' après vert boucle sur blanc
    Case Else
    Target.Interior.Color = RGB(255, 255, 255)   ' Après autre couleur  --> blanc
    End Select
End If
End Sub

il y a un pb sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  Case Interior.Color = RGB(255, 255, 255)

Erreur d'exécution 424 objet requis ?
Pb de syntaxe ?