Résolu Coloration cases de planning

[sergent_7]

bonjour à tous.

je dois actuellement réaliser un planning des taches.

sur la deuxième ligne du tableau excel se situent les numéros de semaines
ensuite, on remplit chaque ligne une par une , avec les différentes taches, la durées de la tâche, commentaires, etc.... et en fonction de la date souhaité, le numéro de semaine correspondante est automatiquement rempli.

pour le moment, j'ai réussi à remplir les cases se situant à l'intesection des numéros de semaines désirées de chaque tache , et de celle du planning en 2ème ligne

comme on peut le voir ici :

[

Vous devez être connecté pour voir les liens.

ceci est réalisé avec une formule du type si (...=...;"o";"") ainsi qu'une mise en forme conditionnelle qui colorie la case en jaune si la valeur o apparait.

ma question est simple:

Comment faire pour colorier les cases précédents la case coloriée ? le nombre de case à colorier étant celui indiqué dans la durée de la tache.

le but du jeu étant que tout se fasse automatiquement, sans appuyer sur un bouton. J'ai commencé une macro, mais je ne vois pas d'une part comment la déclencher, et d'autre part quoi mettre dedans exactement

[cpp]
Dim i, j As Integer
i = 48
j = Worksheet.Range("Q&i").Value

[/cpp]
i correspondant au numéro de la ligne , et j à la valeur de la durée de la tâche.



Merci d'avance

 

[zeb]

Salut,

Dis donc, tu ne serais pas en train de confondre Microsoft Excel avec Microsoft Project ? :heink:

Bon, passons. C'est pas toi le coupable, c'est ton patron :sarcastic:

-------------------------​

Tu as donc commencé une macro ! Eh ben c'est déjà un début, un tout petit petit début

Sache qu'on peut faire ça sans une ligne de code VB. Mais comme tu poses ta question ici, on va faire ça en VBA (macro).
Donc on va virer les formules "du type si" et les mises en forme conditionnelles.

Et on va faire de la programmation événementielle. C'est-à-dire qu'on va demander à Excel de réagir à certains stimuli. L'événement Change sur la feuille est un stimulus très intéressant que je te laisse un peu regarder.

Quand tu auras assouvi ta curiosité à cet endroit, dis-nous ce que tu en penses. Alors, on continuera...

 

[sergent_7]

en effet, mon patron est quelque peu... rétissant au changement on va dire et préfère des bonnes vieilles macro excel aux outils plus performants (mais qui coûtent certes aussi plus cher).

Je vais regarder cette fonction et je reviens vers vous dès que j'ai un souci.

dans l'architecture de ma macro, je pensais faire quelque chose du genre :

je me place à la première ligne, je teste si elle est vide, si c'est le cas, je me déplace d'un cran vers la droite, et ce jusqu'à ce que je trouve une case non vide ( celle ou le "o" a été rempli) . je viens ensuite récupérer la valeur de la durée de la tache, et je rempli de "o" le nombre de cases précédents ma case colorée initialement.
ensuite je passe à la ligne suivante et je recommence.

le problème qui risque de se poser est l'arret de la macro, car il risque d'aller jusqu'à la ligne 65000 , mais bon, c'est l'idée principale, après ça n'est qu'un "détail " ^^ .

maintenant si on enlève les mise en forme conditionnelles, l'action a réalmiser au lieu d'écrire "o" sera de colorer la cellule, ce qui revient au même (mais j'avoue, c'est un peu plus propre)

que pensez vous de la démarche de la macro ? feriez vous différemment ?

 

[zeb]

Salut,

Rhalala, ces patrons radins :sarcastic: Du coup, j'espère qu'il te paye bien.
Excel est un tableur, pas une bonne à tout faire

------------------------------------------

Ben non, je ne ferais pas du tout comme ça.
Comme j'utiliserais l'événement Worksheet_Change, je n'aurais que la ligne concernée à traiter. T'as un peu regardé cette fonction ?

 

[sergent_7]

en tant que stagiaire, je suis exploité... enfin bref, ça n'est pas le sujet ^^

pour la fonction change , j'ai regardé un peu ce quelle fait. elle peut être utile en effet

je peux utiliser l'attribut row de ma target pour définir le numéro de la ligne ( target.row j'imagine), ainsi mon paramètre que je nommais "i" sera renseigné

je sais donc sur quelle ligne je travaille. maintenant il me faut trouver le moyen d'identifier la cellule dont la valeur est identique dans la deuxième ligne de mon tableau excel ( correspondant aux numéros de semaine calendaires) et colorier les j cellules précédentes ( enfin les j-1 vu que la cellule intersection fait partie de la durée également)

que pensez vous d'un truc du style :



imaginons que l'on se place en "Ri" , on prend la valeur "Bi"( numéro de semaine calendaire) , si elle est différente de la valeur "Pi" ( numéro de semaine désiré), on se place sur la cellule suivante, et on recommence, jusqu'à ce qu'elle soit égale. là on colorie la case, et on colorie ensuite les cases en revenant "vers la gauche". on colorie autant de cases que le paramètre "j" l'indique ( on aurait un petit compteur décrémental dans cette fonction en se déplaçant )

 

[zeb]

Arrête de me dire vous, c'est agaçant.

Eh, ben c'est bien vu tout ça.
Il ne s'agit pas seulement de colorier des cellules, il faut aussi les effacer. En effet, si on change la durée, avec un nombre plus petit par exemple, il faut colorier les uns et effacer les autres.

Alors voilà comment je te propose de faire. On ne va réagir que sur les lignes 3 à 10 (arbitrairement, tu ajusteras) et sur les colonnes P et Q.

Sub Worksheet_Change(Target As Range)
    If  3 <= Target.Row And Target.Row <= 10 And _
       17 <= Target.Column And Target.Column <= 18 _
    Then
        ' // On est bon :)
        ...
    End If
End Sub

Bon, maintenant qu'on a la ligne y, on va de la colonne R (20) à la fin (255).
Si on trouve Py dans la ligne 2, on a la fin de ta zone. Disons que c'est la colonne x.
Ensuite, le début est facilement calculable. C'est la ligne y, et la colonne x - Py. Attention, faut pas que ça dépasse R !

Je n'ai pas Excel sous la main, je te laisse réfléchir. A demain.

 

[sergent_7]

Re bonjour,

en cette journée ensoleillée, j'ai pas mal avancé sur mon problème, mais rien ne se passe. ^^

voici mon code :

[cpp]Sub Worksheet_Change(Target As Range)
Dim i, j, k As Integer


If 3 <= Target.Row.Count And 16 <= Target.Column.Count And Target.Column.Count <= 17 _
Then
i = Target.Row.Count
j = Worksheet.Range("Q&i").Value ' il s'agit ici de la durée de la tâche

' pour info, Q correspond à la colonne 16, et R à la 17

Worksheet.Range("R&i").Select

k = Worksheet.ActiveCell.Column

' On commence par effacer ce qu'il y a sur la ligne

Range("R&i:AN&i").Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone

While Worksheet.Cells("i,16") <> Worksheet.Cells("2,k") ' On teste si les numéros de semaine correspondent afin de trouver le croisement "ligne-colonne"

Do
ActiveCell.Offset(0, 1).Select ' si ce n'est pas le cas, on se déplace d'une cellule a droite et on recommence

k = Worksheet.ActiveCell.Column
Loop

' quand on est à l'intersection, on écrit dans la cellule et on la colorie

ActiveCell.FormulaR1C1 = "o"
Selection.Font.ColorIndex = 6
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

While j <> 0 ' on va ensuite se déplacer vers la gauche afin de colorier le nombre de cases necessaires

Do
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "o"
Selection.Font.ColorIndex = 6
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
j = j - 1


Loop


End If
End Sub

[/cpp]

Je pense qu'il ne s'agit que d'une petite subtilité, mais je n'arrive pas à la cerner. :??: :fou: :wahoo:

 

[zeb]

C'est vraiment pas mal. +1
Mais il y a encore du boulot

Mettre Option Explicit au début du code.
C'est impératif et non négociable !
--> Déclarer et initialiser les variables.

Exercice
Comprendre la différence entre ces deux lignes :

Msgbox "R&i"
Msgbox "R" & i

--> Réécrire la ligne 12
Dans le cas des adresses de Range("...") à créer, préférer la syntaxe Cells(Row, Column).

Ligne 12 et 14. Ne pas utiliser de Select/Activate ni de Selection/ActiveTruc.

' // Code très moche qui ralentit très fortement les traitements
Range("xx").Select
...Selection.Column...

' // Code propre et efficace
... Range("xx").Column ...

--> Réécrire proprement le code.

Tu essaies de me réécrire ça ?

 

[sergent_7]

[cpp]Sub Worksheet_Change(Target As Range)
Option Explicit

Dim i, j, k As Integer


If 3 <= Target.Row.Count And 16 <= Target.Column.Count And Target.Column.Count <= 17 _
Then
i = Target.Row.Count
j = Worksheet.Cells("i, 17").Value ' il s'agit ici de la durée de la tâche

' pour info, Q correspond à la colonne 16, et R à la 17

k = Worksheet.Cells("i, 18").Column

' On commence par effacer ce qu'il y a sur la ligne

'Range("R&i:AN&i").Select
Range("Cells(i,18):Cells(i,45)").Select

Selection.ClearContents
Selection.Interior.ColorIndex = xlNone

While Worksheet.Cells("i,16") <> Worksheet.Cells("2,k") ' On teste si les numéros de semaine correspondent afin de trouver le croisement "ligne-colonne"

Do
ActiveCell.Offset(0, 1).Select ' si ce n'est pas le cas, on se déplace d'une cellule a droite et on recommence

k = Worksheet.ActiveCell.Column
Loop

' quand on est à l'intersection, on écrit dans la cellule et on la colorie

ActiveCell.FormulaR1C1 = "o"
Selection.Font.ColorIndex = 6
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

While j <> 0 ' on va ensuite se déplacer vers la gauche afin de colorier le nombre de cases necessaires

Do
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "o"
Selection.Font.ColorIndex = 6
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
j = j - 1


Loop


End If
End Sub[/cpp]

voici mon code un peu plus propre ... même motif, même punition, rien ne se passe. :??: t1cable:

pour info, j'ai essayé de faire ton petit exercice juste après la déclaration des variables , c'est à dire après le
[cpp]
i = Target.Row.Count
j = Worksheet.Cells("i, 17").Value ' il s'agit ici de la durée de la tâche[/cpp],
et rien ne se passe lors de la modification des cellules, le message Box n'apparait même pas ...

 

[zeb]

T'as vraiment fait l'exercice, et t'as toujours pas compris
M'enfin !Recommence :

Msgbox "i, 17"
Msgbox i & " " & 17

Bon, sinon, première erreur de ma part, ce n'est pas

Sub Worksheet_Change(Target As Range)

mais

Sub Worksheet_Change(ByVal Target As Range)

La différence est subtile.

Maintenant, regarde l'aide de Option Explicit. Le môssieu à dit "Au début du code".

Sub Worksheet_Change(ByVal Target As Range)

    ' // Pas bien. Seul k est entier.
    Dim i, j, k As Integer
    
    ' // Bien.
    Dim i As Integer, j As Integer, k As Integer
 
    If 3 <= Target.Row.Count And 16 <= Target.Column.Count And Target.Column.Count <= 17 _
    Then
        i = Target.Row.Count
        j = Worksheet.Cells("i, 17").Value  ' il s'agit ici de la durée de la tâche
 
    ' pour info, Q correspond à la colonne 16, et R à la 17
    ' // VIRE LES GUILLEMETS !
    k = Worksheet.Cells("i, 18").Column
 
    ' On commence par effacer ce qu'il y a sur la ligne
 
    'Range("R&i:AN&i" ).Select
    ' // VIRE LES GUILLEMETS, et au passage, relis l'aide sur Range et remplace les : en conséquence
    ' // VIRE LE SELECT
    Range("Cells(i,18):Cells(i,45)").Select
    ' // VIRE LE SELECTION
    Selection.ClearContents
    ' // VIRE LE SELECTION
    Selection.Interior.ColorIndex = xlNone
 
    ' // VIRE LES GUILLEMETS !
    ' // While Do, ça n'exite pas en VB. Relis l'aide
    While Worksheet.Cells("i,16") <> Worksheet.Cells("2,k")     ' On teste si les numéros de semaine correspondent afin de trouver le croisement  "ligne-colonne"
    Do
            ' // VIRE LE SELECT
            ActiveCell.Offset(0, 1).Select ' si ce n'est pas le cas, on se déplace d'une cellule a droite et on recommence
            ' // VIRE LE ACTIVETRUC
            k = Worksheet.ActiveCell.Column
        Loop
    ' quand on est à l'intersection, on écrit dans la cellule et on la colorie
    ' // VIRE LE ACTIVETRUC
    ActiveCell.FormulaR1C1 = "o"
    ' // VIRE LE SELECTION
      Selection.Font.ColorIndex = 6
    ' // VIRE LE SELECTION
    With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
 
    ' // While Do, ça n'exite pas en VB. Relis l'aide
    While j <> 0 ' on va ensuite se déplacer vers la gauche afin de colorier le nombre de cases necessaires
        Do
            ' // VIRE LE ACTIVETRUC
            ActiveCell.Offset(0, -1).Select
            ' // VIRE LE ACTIVETRUC
              ActiveCell.FormulaR1C1 = "o"
              ' // VIRE LE SELECTION
            Selection.Font.ColorIndex = 6
            ' // VIRE LE ACTIVETRUC
        With Selection.Interior
            .ColorIndex = 6
            .Pattern = xlSolid
        End With
    j = j - 1
         
       
        Loop
 
     
    End If
End Sub

Je ne vais pas faire ton boulot, mais je vais aider à te le faire faire.
A la fin, ce sera ton code, et il fonctionnera.
Il fonctionnera bien en plus :sol:

 

[sergent_7]

En effet, je n'avais pas pu faire l'exercice, car comme je l'ai dit précédemment, les message box ne se lancaient pas ( je les avait mis dans ma macro, se déclenchant au changement de le cellule). Je l'ai refait dansune autre macro, et tout à marché, et j'ai compris l'erreur avec les guillemets, cela correspond à la lettre i , alors que sans, a chaque fois qu'il croisera la lettre i , il la remplacera par sa valeur;

j'ai cependant toujours le même problème de déclenchement de ma macro , rien ne se passe au changement des valeurs concernées.... :??:

voici mon code , version 3 ^^

[cpp] Option Explicit

Sub Worksheet_Change(ByVal Target As Range)


Dim i As Integer, j As Integer, k As Integer

If 3 <= Target.Row.Count And 16 <= Target.Column.Count And Target.Column.Count <= 17 _
Then
i = Target.Row.Count
j = Worksheet.Cells(i, 17).Value ' il s'agit ici de la durée de la tâche



k = Worksheet.Cells(i, 18).Column

' On commence par effacer ce qu'il y a sur la ligne

'Range("R&i:AN&i").Select
Range(Cells(i, 18), Cells(i, 45)).ClearContents
Range(Cells(i, 18), Cells(i, 45)).Interior.ColorIndex = xlNone


While Worksheet.Cells(i, 16) <> Worksheet.Cells(2, k) ' On teste si les numéros de semaine correspondent afin de trouver le croisement "ligne-colonne"


Offset(0, 1).Select ' si ce n'est pas le cas, on se déplace d'une cellule a droite et on recommence

k = Worksheet.ActiveCell.Column
Wend

' quand on est à l'intersection, on écrit dans la cellule et on la colorie

FormulaR1C1 = "o"
Font.ColorIndex = 6
With Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

While j <> 0 ' on va ensuite se déplacer vers la gauche afin de colorier le nombre de cases necessaires


Offset(0, -1).Select
FormulaR1C1 = "o"
Font.ColorIndex = 6
With Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
j = j - 1


Wend


End If
End Sub
[/cpp]

au passage, merci beaucoup de m'aider à ce point :ange:

 

[zeb]

au passage, merci beaucoup de m'aider à ce point

Je t'en prie.

Pas mal.

Il reste un activetruc en ligne 29 et un Select en ligne 44.

Les While Do .. Loop, ça n'existe pas. Les While .. Wend, ça ne devrait plus exister. Utilise des Do While .. Loop. Là encore, la différence est subtile

Quand je te dis de virer un truc, il faut sans doute le remplacer par quelque chose.

Bon, et puis Target.Row.Count et Target.Column.Count, ça n'existe pas. [strike]Il fallait lire Target.Rows.Count et Target.Columns.Count. On le compte pas une ligne, une colonne mais des lignes, des colonnes[/strike]. Mea Culpa.

EDIT : Il fallait lire Target.Row et Target.Column. Re-Mea Culpa.

Bon, maintenant, on va vérifier le déclenchement :

Sub Worksheet_Change(ByVal Target As Range)
    MsgBox "Changement"
    If 3 <= Target.Row And 16 <= Target.Column And Target.Column <= 17 _
    Then
        MsgBox "Et on est dans la bonne zone !"
    End If
End Sub

Qu'est-ce que ça donne ?

 

[sergent_7]

le active truc en ligne 29 me permet de spécifier le numéro de colonne de la cellule active. pourquoi le supprimer ? à ce moment là je pourrais laisser k en tant que variable compteur et l'incrémenter à chaque fois que je passe d'une cellule à l'autre.

Pour ce qui est du select de la ligne 44, c'est bien l'opération que je veux faire, me placer (selectionner) la cellule précédente. j'ai du mal à cerner en quoi c'est un problème en fait.


Pour ce qui est du déclenchement... rien ne se passe. le premier msgbow "changement" n'apparait pas . :s pourtant mes macros sont actives dans le classeur et la syntaxe est correcte .... c'est étrange....

 

[zeb]

Non, tu ne veux pas sélectionner une cellule. Tu veux y faire référence.
(Comment ça je sais mieux que toi ce que tu veux faire ?! )

' // Pas bien
... Offset(0, 1).Select
k = Worksheet.ActiveCell.Column

' // Bien
k = ... Offset(0, 1).Column

Tu comprends ?

Tu peux aussi pointer la cellule par une variable :

Dim ma_cellule As Range
Set ma_cellule = ... Offset(0, 1)
k = ma_cellule.Column

Pour ce qui est du déclenchement...

Où as-tu enregistré ton code ?

 

[sergent_7]

j'avais enregistré mon code dans... module 1, ça ne risquait pas de fonctionner , en effet ^^

je l'ai remis dans la bonne feuille, et il se déclenche ^^ . par contre il ne déclenche pas le second message box indiquant que l'on se trouve dans la bonne zone. les colonnes 16 et 17 sont pourtant bel et bien celles qui m'intéressent (comportant respectivement les numéro de semaine et durée des tâches)

[cpp] If 3 <= Target.Rows.Count And 16 <= Target.Columns.Count And Target.Columns.Count <= 17 Then

MsgBox "Et on est dans la bonne zone !"
End If
[/cpp]

 

[zeb]

Oulala.... Je ne devais pas être réveillé quand j'ai écrit ça. Désolé.

Vous devez être connecté pour voir les liens.

Pour t'avoir roulé dans la farine, je te propose de bien étudier ce morceau de code :

Const n°col_semaine  As Integer = 16
Const n°col_duree    As Integer = n°col_semaine + 1
Const n°col_zone_1er As Integer = 18
Const n°col_zone_der As Integer = 40

Dim cell         As Range
Dim cell_1er     As Range
Dim cell_der     As Range
Dim x            As Integer
Dim zone_jaune   As Range
Dim zone_blanche As Range

' // Nettoyage
Set zone_blanche = Me.Range(Target.EntireRow.Cells(n°col_zone_1er), _
                            Target.EntireRow.Cells(n°col_zone_der))
zone_blanche.Clear

' // C'est parti
For Each cell In Me.Range(Me.Cells(2, n°col_zone_1er), _
                          Me.Cells(2, n°col_zone_der))
    If cell.Value = Target.EntireRow.Cells(n°col_semaine).Value Then
        ' // Trouvé la dernière.
        Set cell_der = Me.Cells(Target.Row, cell.Column)
        
        ' // Cherchons la première.
        x = CInt(Target.EntireRow.Cells(n°col_duree).Value)
        Set cell_1er = cell_der.Offset(, 1 - x)
        
        ' // Petite vérif
        If cell_1er.Column < n°col_zone_1er Then
            Set cell_1er = Target.EntireRow.Cells(n°col_zone_1er)
        End If
            
        ' // Colorions la zone
        Set zone_jaune = Me.Range(cell_1er, cell_der)
        zone_jaune.Interior.ColorIndex = 6
    End If
Next

Ça devrait te plaire

 

[sergent_7]

l'architecture est totalement différente, mais certainement plus propre

au niveau de la coloration de la case en jaune, il me mettait une erreur, je l'ai corrigé en rajoutant ceci:

[cpp] zone_jaune.Font.ColorIndex = 6[/cpp]

Cependant, le code ne fonctionne pas totalement. Il m'éfface bien la zone blanche entière( y compris le quadrillage,mais bon, ce n'est qu'un détail ) , mais il ne me colorie pas la jaune.

j'effectue quelques tests pour essayer d'identifier le problème

 

[zeb]

Ne cherche plus
(La vache, pourquoi j'ai tant de mal avec toi ?)

Eh, ça correspond à ce que je proposais au départ :

Vous devez être connecté pour voir les liens.

 

[sergent_7]

Merci beaucoup ! tout fonctionne parfaitement !

j'ai juste rajouté un petit

[cpp]zone_blanche.Borders(xlInsideVertical).LineStyle = xlContinuous[/cpp] pour remettre les bordures des cellules.

un énorme merci

 

[zeb]

Ah oui, j'ai utilisé Clear à la ligne 16. C'est un peu violent, je te l'accorde. Soit on met un peu de lessive :

Range.Interior.ColorIndex = xlNone

Soit on y va à l'eau de javel concentrée [atch]

Range.Clear

.

Désol', je suis un bourrin [:nospheratu].

Choisis la moins mauvaise des réponses pour passer ce topic à [Résolu].