Mise en Forme par macros

  • Initiateur de la discussion Initiateur de la discussion WilsonMD
  • Date de début Date de début

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 !

WilsonMD

XLDnaute Nouveau
Bonjour à tous,

Je souhaite résoudre un problème de macros, je vous explique rapidement le principe. Je veux instaurer un niveau d'alerte en fonction de la date d'échéance d'une tâche :
- bleue: terminée
- vert : +3 de jours avt date
- orange : moins de 3 jours avt deadline
- rouge : jour de la date butoir
- noir : retard

Avec le code suivant j'arrive à appliquer ce raisonnement
- si date remplie, tâche faite dc cellule > 1 : bleu
- si différence date butoir - date d'aujourd"hui > 3 vert
-si différence < 3 orange
et ainsi de suite

je précise que je pars sur une macro car cet élément va s'inscrire dans un calcul plus complexe sur un gantt

Ma question est comment faire pour que le test s'applique à toutes les cellules de la colonne et non seulement E3. J'ai mis un visuel où les couleurs ne viennent pas de la macro mais st faites manuellement pr voir le résultat voulu.

Sub Essai_MEFC_par_macros()
Dim MaFeuille As Worksheet, Test As Double, Opr1 As Double, Opr2 As Double
Set MaFeuille = Application.Workbooks("Essai MEFC par macros.xlsm").Worksheets("Feuil1")

Test = Range("D3")
Opr1 = Range("C3")
Opr2 = Range("D3")

If Test > 1 Then
MaFeuille.Range("E3").Interior.ColorIndex = 32
ElseIf Opr1 - Opr2 < 0 Then
MaFeuille.Range("E3").Interior.ColorIndex = 1
ElseIf Opr1 - Opr2 <= 1 Then
MaFeuille.Range("E3").Interior.ColorIndex = 3
ElseIf Opr1 - Opr2 <= 3 Then
MaFeuille.Range("E3").Interior.ColorIndex = 45
Else
MaFeuille.Range("E3").Interior.ColorIndex = 10
End If

End Sub

captureexcel.th.jpg]
[/URL] Uploaded with ImageShack.us[/IMG]

Merci d'avance pour votre aide
 
Dernière édition:
Re : Mise en Forme par macros

merci pour cette réponse rapide, j'ai ceci mais cela me met un bug

Test = Range("D3")
Opr1 = Range("C3")
Opr2 = Range("D3")

If Test > 1 Then
MaFeuille.Range("E.E").Interior.ColorIndex = 32
ElseIf Opr1 - Opr2 < 0 Then
MaFeuille.Range("E.E").Interior.ColorIndex = 1
ElseIf Opr1 - Opr2 <= 1 Then
MaFeuille.Range("E.E").Interior.ColorIndex = 3
ElseIf Opr1 - Opr2 <= 3 Then
MaFeuille.Range("E.E").Interior.ColorIndex = 45
Else
MaFeuille.Range("E.E").Interior.ColorIndex = 10
End If

End Sub

Je dois aussi changer le test? Ou écrire différemment?
 
Re : Mise en Forme par macros

Bonsoir


Tu as déclaré Test en Double
Or D3 contient du texte, c'est D4 plutôt non ?

(Dim Test As Long serait plus logique)

Donc :
Code:
Sub Essai_MEFC_par_macros()
Dim MaFeuille As Worksheet, Test&, Opr1&, Opr2&
Dim Plage As Range
Set MaFeuille = Sheets("Feuil1")

Set Plage = MaFeuille.Range("E4:E" & MaFeuille.[B65536].End(xlUp).Row)

Test = Range("D4").Value
Opr1 = Range("C4").Value
Opr2 = Range("D4").Value

    If Test > 1 Then
        Plage.Interior.ColorIndex = 32
    ElseIf Opr1 - Opr2 < 0 Then
        Plage.Interior.ColorIndex = 1
    ElseIf Opr1 - Opr2 <= 1 Then
        Plage.Interior.ColorIndex = 3
    ElseIf Opr1 - Opr2 <= 3 Then
        Plage.Interior.ColorIndex = 45
    Else
        Plage.Interior.ColorIndex = 10
    End If
     
End Sub
 
Dernière édition:
Re : Mise en Forme par macros

Merci pour ces éclaircissements. J'ai encore cependant un problème. C'est le résultat du test effectué sur la ligne D4 qui s'affiche sur toute la plage en l'occurence ici tout est bleu

alors que je voudrais que le test se fasse à chaque fois par ligne pour savoir pour chaque tâche si l'on est ds le temps ou non

C4-F4 : niveau d'alerte E4
C5-F5 : niveau d'alerte E5
C6-F6 : niveau d'alerte E6
et ainsi de suite

Là le test sur la ligne 4 me donne le résultat pour toutes les lignes alors qu'il n'est pas commun à tous les niveaux d'alerte puisqu'il y a un test par tâche donc par ligne et qu'ils st indépendants
 
- 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

Réponses
2
Affichages
868
Retour