[Resolu] Comment recopier selon criteres une ligne avec mise en forme de cellules

[BZH56]

Bonjour au fil
J utilise un planning dont je voudrais faciliter l 'usage en effectuant une recopie automatique du planning horaire journalier selon les horaires théoriques prévus.
En sélectionnant un critère 'horaire' , une copie couleur des horaires serait recopie automatiquement sur la ligne correspondante.
ci joint le modèle commente .
Merci d avance aux" VBistes"
Bon WE a tous

 

[eriiic]

Re : Comment recopier selon criteres une ligne avec mise en forme de cellules

Bonjour,

A tester :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim couleur As Long, c As Long
    If Target.Row < 3 Then Exit Sub
    Select Case Target.Column
    Case 5
        If Target = "" Or Target.Offset(0, 1) <> "" Then
            Cells(Target.Row, 7).Resize(1, 44).Interior.ColorIndex = xlNone
        Else
            couleur = Cells(Target.Row, 1).Interior.ColorIndex
            For c = 1 To 44
                If Worksheets("Tables").Range(Target.Value).Offset(0, c).Interior.ColorIndex = 15 Then
                    Cells(Target.Row, 6).Offset(0, c).Interior.ColorIndex = xlNone
                Else
                    Cells(Target.Row, 6).Offset(0, c).Interior.ColorIndex = couleur
                End If
            Next c
        End If
    Case 6
        If Target = "" Then
            Call Worksheet_Change(Target.Offset(0, -1))
        Else
            Cells(Target.Row, 7).Resize(1, 44).Interior.ColorIndex = xlNone
        End If
    End Select
End Sub

eric

edit : sur Tables j'ai nommé les cellules Ouv, Ferm, etc
Je me base sur le gris de la définition des plages, ne pas changer cette couleur. Par contre tu peux changer le orange.

 

[Bebere]

Re : Comment recopier selon criteres une ligne avec mise en forme de cellules

bonjour Bzh
clic droit onglet modele,visualiser le code
à bientôt

 

[BZH56]

Re : Comment recopier selon criteres une ligne avec mise en forme de cellules

merci eric , les premiers test semblent ok - il me reste a insérer des commentaires dans le code car c est la première fois que j'introduis "target" dans du code et le - 1 par exemple , ci après me laisse perplexe " Call Worksheet_Change(Target.Offset(0, -1))".
merci aussi a bebere mais il y a un bug quand on saisit une absence ,le fichier plante
si tu corriges ,je pourrais comparer vos 2 propositions
@+

 

[eriiic]

Re : Comment recopier selon criteres une ligne avec mise en forme de cellules

Call Worksheet_Change(Target.Offset(0, -1))
En cas d'effacement du motif de l'absence je rappelle la routine en lui passant la référence de la cellule à gauche (-1) pour simuler une saisie de la plage horaire et colorer à nouveau les cellules en conséquence.
eric

 

[Bebere]

Re : Comment recopier selon criteres une ligne avec mise en forme de cellules

bonjour Eriiic
Bzh,pas eu de plantage mais une faute la couleur ne s'effaçait pas si une absence était entrée
à bientôt

 

[BZH56]

Re : Comment recopier selon criteres une ligne avec mise en forme de cellules

eric, merci des précisions
par contre je viens de tester que si tu sélectionnes plusieurs cellules dans la colonne code horaire ou absences pour effacer ou recopier vers le bas, on a un message d'erreur 'erreur d execution 13 - incompatibilité de type".
Peux t on régler ce problème ?
merci

 

[eriiic]

Re : Comment recopier selon criteres une ligne avec mise en forme de cellules

Bonjour bebere, re BZH,

J'ai modifié, par contre je limite à la largeur de la sélection à 1 colonne :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim couleur As Long, c As Long, cel As Range
    If Target.Row < 3 Or Target.Columns.Count > 1 Then Exit Sub
    For Each cel In Target
        Select Case cel.Column
        Case 5
            If cel = "" Or cel.Offset(0, 1) <> "" Then
                Cells(cel.Row, 7).Resize(1, 44).Interior.ColorIndex = xlNone
            Else
                couleur = Cells(cel.Row, 1).Interior.ColorIndex
                For c = 1 To 44
                    If Worksheets("Tables").Range(cel.Value).Offset(0, c).Interior.ColorIndex = 15 Then
                        Cells(cel.Row, 6).Offset(0, c).Interior.ColorIndex = xlNone
                    Else
                        Cells(cel.Row, 6).Offset(0, c).Interior.ColorIndex = couleur
                    End If
                Next c
            End If
        Case 6
            If cel = "" Then
                Call Worksheet_Change(cel.Offset(0, -1))
            Else
                Cells(cel.Row, 7).Resize(1, 44).Interior.ColorIndex = xlNone
            End If
        End Select
    Next cel
End Sub

 

[BZH56]

Resolu : Comment recopier selon criteres une ligne avec mise en forme de cellules

bonsoir eric
l ajout d'une boucle supplémentaire me semble efficace et elle répond a ma demande de sélection multiple..
je ne peux que te dire , contrat rempli
merci eric