Colorisation secteur par clic

[alb05]

Bonjour
Pour suivre l'avancement d'une activité, j'utilisation un secteur divisé en 4 partie. Chaque partie représentant une progression de 25%
Est il possible avec Excel 2010, que la partie du secteur sur lequel je clic je colorise en vert automatiquement.
Merci de votre aide.

 

[job75]

Re : Colorisation secteur par clic

Bonjour alb05,

Je suis sur Excel 2010 et j'ai (re)fabriqué 4 secteurs.

La même macro affectée à chacun d'eux (Alt+F11) :

Sub CouleurSecteur()
  With ActiveSheet.Shapes(Application.Caller).Fill.ForeColor
  .RGB = IIf(.RGB = RGB(255, 255, 255), RGB(0, 176, 80), RGB(255, 255, 255))
  End With
End Sub

Clic pour colorer, clic pour décolorer...

Fichier joint.

A+

 

[Robert]

Re : Colorisation secteur par clic

Bonjour Alb, bonjour le forum,

Une proposition sans formes. Clique dans une cellule pour la colorer, reclique dessus pour enlever la couleur... Le poucentage s'actualise.
Le code :

Dim test As Boolean 'déclare la variable test

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pl As Range 'déclare la variable pl (PLage)

If test = True Then Exit Sub 'si test est vrai, sort de la procédure
Set pl = Application.Union(Range("B2:C3"), Range("E2:F3"), Range("H2:I3"), Range("K2:L3")) 'définit la variable pl
If Application.Intersect(Target, pl) Is Nothing Then Exit Sub 'le le clic a lieu ailleurs que dans la plage pl, sort de la procédure
test = True 'définit la variable test
If Target.Value = "" Then 'condition : si a cellule cliquée est vide
    Target.Font.ColorIndex = 50 'couleur de la polioce vert marin
    Target.Interior.ColorIndex = 50 'couleur de la cellule vert marin
    Target.Value = 1 'valeur de la cellule égale à 1
Else 'sinon
    Target.Font.ColorIndex = 1 'couleur de la police noir
    Target.Interior.ColorIndex = xlNone 'couleur de la cellule "sans"
    Target.Value = "" 'efface la valeur de la cellule
End If 'fin de la condition
Cells(1, Target.Column).Select 'sélectionne la cellule de la première ligne
test = False 'redéfinit la variable test
End Sub

Le fichier :

[Édition]
Bonjour Job on s'est croisé...

 

[alb05]

Re : Colorisation secteur par clic

rebonjour
merci à tous les 2.

Job,
Un quart n'existe pas en xls 2010 dans les formes par défaut
comment as tu fait pour (re)fabriquer ces secteurs ?
2 traits et une courbe ???

 

[pierrejean]

Re : Colorisation secteur par clic

bonjour alb05 , Job , Robert

j'ai commis ceci , je le livre (tous pourcentages possible (cellule J18)) et regarde vos oeuvres

Si acceptable , on peut aller plus loin

 

[pierrejean]

Re : Colorisation secteur par clic

Re

@ alb05

En l'absence de l'ami Job
Pour recreer un secteur :
Insertion > Formes > formes de base > secteurs (au depart 3/4 d'un cercle)
Ensuite les points jaunes au nord et à l'est permettent d'obtenir n'importe quelle division en secteur par selection et glisser (le long du cercle)

 

[job75]

Re : Colorisation secteur par clic

Bonjour Robert, pierrejean

Une autre manière de colorer les secteurs :

Sub CouleurSecteur()
  Dim s As Object
  ThisWorkbook.Names.Add "CAS", ([CAS] + 1) Mod 5
  Select Case [CAS]
    Case 1
      Set s = ActiveSheet.Shapes("Secteurs 1")
    Case 2
      Set s = ActiveSheet.Shapes.Range(Array("Secteurs 1", "Secteurs 2"))
    Case 3
      Set s = ActiveSheet.Shapes.Range(Array("Secteurs 1", "Secteurs 2", "Secteurs 3"))
    Case 4
      Set s = ActiveSheet.Shapes.Range(Array("Secteurs 1", "Secteurs 2", "Secteurs 3", "Secteurs 4"))
    Case 0
      ActiveSheet.Shapes.Range(Array("Secteurs 1", "Secteurs 2", "Secteurs 3", "Secteurs 4")) _
        .Fill.ForeColor.RGB = RGB(255, 255, 255) 'blanc
        Exit Sub
  End Select
  s.Fill.ForeColor.RGB = RGB(0, 176, 80) 'vert
End Sub

Ici les secteurs sont numérotés dans l'ordre, mais ce n'est pas indispensable.

Fichier (2).

A+

 

[job75]

Re : Colorisation secteur par clic

Re,

Une autre manière d'écrire la macro précédente (je préfère) :

Sub CouleurSecteur()
  Dim a(), i As Integer
  a = Array("Secteurs 1", "Secteurs 2", "Secteurs 3", "Secteurs 4")
  ThisWorkbook.Names.Add "CAS", ([CAS] + 1) Mod 5
  ActiveSheet.Shapes.Range(a).Fill.ForeColor.RGB = RGB(255, 255, 255) 'blanc
  For i = 0 To [CAS] - 1
    ActiveSheet.Shapes.Range(a(i)).Fill.ForeColor.RGB = RGB(0, 176, 80) 'vert
  Next
End Sub

Fichier (2bis).

A+

 

[job75]

Re : Colorisation secteur par clic

Bonjour le fil, le forum,

Sans VBA, une solution très simple avec liste de validation et graphique à secteurs.

A+

 

[pierrejean]

Re : Colorisation secteur par clic

Re

Super travail Job

 

[job75]

Re : Colorisation secteur par clic

Bonjour pierrejean,

Merci Pierre

Pour en terminer avec le graphique, on peut lui affecter cette macro très simple :

Sub Secteurs()
[Cible] = ([Cible] + 25) Mod 125 'cellule nommée
End Sub

Fichier (2).

Edit : ajouté la cellule avec le pourcentage.

A+