Bordures automatiques

[Racouet]

Bonjour à tous. je dispose d'un planning type Gantt dont le remplissage des couleurs se fait en fonction des dates et de la couleur indiquée en colonne 2. Je recherche une solution macro et non de mise en forme conditionnelle. Egée et Victor 21 m'ont aié pour la solution de coloration automatique, et cette fois, j'aimerai un coup de main pour les bordures svp. je suis nul en macro, mais j'essaye de faire des progrés. Je joint un exemple du fichier en question. J'ai une seconde question, la macro de coloration des cellules ne fonctionne que lorsque je reclick dans la cellule de date.

D'avance merci

 

[phlaurent55]

Re : Bordures automatiques

Bonjour,

J'ai une seconde question, la macro de coloration des cellules ne fonctionne que lorsque je reclick dans la cellule de date.

remplace la macro par ceci:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target.Columns, Columns(7)) Is Nothing And Intersect(Target.Columns, Columns(8)) Is Nothing Then Exit Sub
Application.ScreenUpdating = 0

i = Target.Row
    For j = 9 To 78
        Cells(i, j).Interior.ColorIndex = xlNone
        If Cells(4, j).Value >= Cells(i, 7).Value And Cells(4, j).Value <= Cells(i, 8).Value Then Cells(i, j).Interior.ColorIndex = Cells(i, 2).Interior.ColorIndex
    Next j
Application.ScreenUpdating = 1
End Sub

au lieu de ceci:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

la mise en forme se fera automatiquement dès l'entrée d'une date en colonne G ou H

à+
Philippe

 

[Racouet]

Re : Bordures automatiques

Merci Philippe, mais cxela ne change rien. Je dois toujours recliquer sur la cellule. Une idée pour ajouter des bordures aux cellules colorées ? J'avavais pensé utiliser la fonction activeCells mias je reste coincé.

Merci

 

[phlaurent55]

Re : Bordures automatiques

Re,

Merci Philippe, mais cela ne change rien. Je dois toujours recliquer sur la cellule.

as-tu bien remplacé ton code ?????????

ton fichier en retour

à+
Philippe

 

[James007]

Re : Bordures automatiques

Bonjour,

Tu peux tester le code suivant :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%
Dim j%
If Target.Column <> 6 And Target.Column <> 7 Then Exit Sub
    i = Target.Row
    For j = 9 To 78
        Cells(i, j).Interior.ColorIndex = xlNone
        If Cells(4, j).Value >= Cells(i, 7).Value And Cells(4, j).Value <= Cells(i, 8).Value Then
        Cells(i, j).Interior.ColorIndex = Cells(i, 2).Interior.ColorIndex
        Cells(i, j).BorderAround.Weight = xlThin
        End If
    Next j
End Sub

A +
🙂

 

[Racouet]

Re : Bordures automatiques

Effectivement, désolé, c'est lundi et j'avais oublié de mettre en service le cerveau. C'est chose faite. Merci à tous.

 

[Racouet]

Re : Bordures automatiques

Merci james007, mais celame renvoie un message d'erreur. ce message concerne la ligne ajoutée sur la macro.