Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Simplification code VBA

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

maninwhite

XLDnaute Occasionnel
Bonjour à toutes et à tous

Je reviens sur le forum afin d'obtenir la simplification du code suivant.

Ce code me permet de colorer des formes automatiques suivant la valeur d'une cellule.

Merci

Code: 
Worksheets("Stats FY 1314").Activate
With Worksheets("Stats FY 1314")

If Range("B93").Value >= 1 Then
ActiveSheet.Shapes("tete").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("Oval 8").DrawingObject.Interior.ColorIndex = 4
End If

If Range("B94").Value >= 1 Then
ActiveSheet.Shapes("oeild").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("oeild").DrawingObject.Interior.ColorIndex = 4
End If

If Range("B95").Value >= 1 Then
ActiveSheet.Shapes("oeilg").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("oeilg").DrawingObject.Interior.ColorIndex = 4
End If

If Range("B96").Value >= 1 Then
ActiveSheet.Shapes("cou").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("cou").DrawingObject.Interior.ColorIndex = 4
End If

If Range("B97").Value >= 1 Then
ActiveSheet.Shapes("epauleD").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("epauleD").DrawingObject.Interior.ColorIndex = 4
End If

End With
 
Trier par date Trier par votes
Re : Simplification code VBA

Bonjour maninwhite

A tester:

Code: 
cellules = Array(93, 94, 95, 96, 97)
corps = Array("tete", "oeild", "oeilg", "cou", "epauleD")
For n = LBound(cellules) To UBound(cellules)
 If Range("B" & cellules(n)).Value >= 1 Then
 ActiveSheet.Shapes(corps(n)).DrawingObject.Interior.ColorIndex = 3
 Else: ActiveSheet.Shapes(corps(n)).DrawingObject.Interior.ColorIndex = 4
Next
 
Vote positif 0 Vote négatif
Re : Simplification code VBA

bonjour 🙂

une solution à tester :
Code: 
Worksheets("Stats FY 1314").Activate

With Worksheets("Stats FY 1314")
    For i = 93 To 97
        Select Case i
            Case 93: a = "tete": b = "Oval 8"
            Case 94: a = "oeild": b = "oeild"
            Case 95: a = "oeilg": b = "oeilg"
            Case 96: a = "cou": b = "cou"
            Case 97: a = "epauleD": b = "epauleD"
        End Select
        If .Range("b" & i) >= 1 Then
            ActiveSheet.Shapes(a).DrawingObject.Interior.ColorIndex = 3
        Else
            ActiveSheet.Shapes(b).DrawingObject.Interior.ColorIndex = 4
        End If
    Next i
End With

salut

edit : coucou pierrejean, content de te croiser, joli code minimaliste
 
Vote positif 0 Vote négatif
Re : Simplification code VBA

Re

Salut Hervé
Heureux également de te croiser à nouveau (tu te fais vraiment rare en ce moment)
Correction : Avais pas percuté l'Ovale
Code: 
cellules = Array(93, 94, 95, 96, 97)
corps = Array("tete", "oeild", "oeilg", "cou", "epauleD")
corps_b=Array("Oval 8","oeild", "oeilg", "cou", "epauleD")
For n = LBound(cellules) To UBound(cellules)
 If Range("B" & cellules(n)).Value >= 1 Then
 ActiveSheet.Shapes(corps(n)).DrawingObject.Interior.ColorIndex = 3
 Else: ActiveSheet.Shapes(corps_b(n)).DrawingObject.Interior.ColorIndex = 4
Next
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

P
  • Résolu(e)
Microsoft 365 Afficher ou masquer formes si une cellule est vide
Réponses
11
Affichages
643
pat66
P
  • Résolu(e)
XL pour MAC Code vba pour recherche sur une seule ligne
Réponses
4
Affichages
183
deudecos
P
  • Résolu(e)
Microsoft 365 VBA - Survol d'un Label déclenchement action
Réponses
8
Affichages
335
patricko-13
P
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
481
nabilexcel2007
N
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
486
sylvanu
L
  • Question Question
Microsoft 365 Erreur automation 440 sur code VBA
Réponses
1
Affichages
396
job75
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
3 K
Dranreb
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
818
thunder23
  • Résolu(e)
XL 2010 amélioration code
Réponses
3
Affichages
259
jeanmi
P
  • Résolu(e)
Microsoft 365 macro qui permet de basculer entre 2 valeurs composées de formules de type "Formula local"
2
Réponses
15
Affichages
552
cathodique
M
  • Résolu(e)
Microsoft 365 Trouver une valeur dans une colonne
Réponses
7
Affichages
565
mikeduff
M
F
  • Résolu(e)
Autres Insérer une ligne
2 3
Réponses
36
Affichages
3 K
francescofrancesco
F
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
820
KRUG WOO
K
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
914
TooFatBoy
  • Question Question
XL 2013 Sub commentaire
Réponses
2
Affichages
411
lestoiles1
  • Résolu(e)
Microsoft 365 VBA : Commentaire en B, C, D après clic droit dans n'importe quelle cellule de cette plage ?
2
Réponses
15
Affichages
836
Nicolas JACQUIN
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
2 K
Gestionnaire_rh
G
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
756
Oneida
G
  • Question Question
XL 2021 Macro pour changer les titres de fichier d'archive
Réponses
3
Affichages
700
fanch55
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…