[RÉSOLU] EFFACER LIGNE EN COULEUR en supprimant des données

un internaute

XLDnaute Impliqué
Bonjour le forum
Il y a quelque temps j'ai posté sur ce forum pour résoudre un problème de macro
J'ai obtenu satisfaction gràce à Theze je crois.
Il me semble que Theze est sur un autre forum (c'est ce que j'ai cru comprendre)
Pour être franc j'ai posté sur un autre forum mais sans aucune réponse sauf une demande de fichier ce que j'ai fait
Je suis sous EXCEL 2003
La macro est dans ThisWorkbook
Lorsqu'on efface 3 pour aujourd'hui je voudrais si c'est possible que le fond redeviennent en bleu (interior color index 8)
Lorsqu'on re-ouvre le fichier 3 s'affiche à nouveau c'est normal. (matin ou après-midi ou les 2)
Mais SANS MFC car j'en ai un avec
Merci à vous
Cordialement

Fichier joint
 

Pièces jointes

  • TOTO.xls
    256.5 KB · Affichages: 10

job75

XLDnaute Barbatruc
Bonsoir un internaute,

Pas claire cette affaire, je n'ai pas compris grand-chose :

- pourquoi le fichier est-il en mode de calcul manuel ?

- lorsque l'on passe en mode de calcul automatique B3 passe de 3 à 6...

- pourquoi parler d'effacer B3 puisqu'il y a la formule =SOMME(B6:B33)+SOMME(C6:C33) ?

Il est d'ailleurs bien plus simple d'écrire =SOMME(B6:C33)

A+
 

un internaute

XLDnaute Impliqué
Bonsoir job75
Il est en mode automatique. Quand on ouvre le fichier il met 3. Demain matin en cellule B27 il sera inscrit 3 et si j'ouvre le fichier après 12:00 il sera inscrit 3 dans cellule C27
Donc mal exprimé pas B3
Demain matin toute la ligne 27 sera en intérior color 17
Si je supprime B26 ou C26 maintenant je veux que la ligne soit en interior color 8
Merci à toi
Bonne fin de soirée

Ç'est dans cette macro:

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)    'La Macro COLORISE ne sert plus (mise en commentaires)
    Dim NombreJour As Integer
    Dim Ladate As Date
    Dim MoisSuivant As String
    Dim Plage As Range
    Dim Cel As Range
    Dim F As String
    Dim I As Integer
    Dim J As Integer
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    ' On recherche si la page est surveillée
    If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", Split(Sh.Name, " ")(0), vbTextCompare) Then
        ' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
        NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
        If Target.Row - 5 > Day(Date) Then
            Beep
            MsgBox "PAS LE BON JOUR"
            Target = ""
            Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).Interior.ColorIndex = 8
        Else
            ' Surveille la plage du 1er au dernier jours du mois
            If Not Intersect(Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then
                ' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
                Ladate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
                ' Si la colonne B et la colonne C est vide on efface la date
                Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Ladate)
                ' si la ligne modifiée est la dernière du mois et que la colonne est la C
                If Target.Row = NombreJour + 5 And Target.Column = 3 Then
                    ' On construit le nom de la feuille du mois suivant
                    MoisSuivant = MonthName(Month(DateAdd("m", 1, DateValue(Sh.Name)))) & " " & Year(DateAdd("m", 1, DateValue(Sh.Name)))
                    ' On va vérifier si la feuille existe
                    If FeuilleExiste(MoisSuivant) = False Then Exit Sub
                    ' La feuille existe
                    With Sheets(MoisSuivant)
                        'On la rend visible
                        .Visible = xlSheetVisible
                        ' On masque celle que l'on vient de finir
                        ActiveSheet.Visible = xlSheetHidden
                        ' et on la sélectionne
                        .Select
                    End With
                End If
            End If
            If Range("A" & Target.Row) <> "" Then
                Application.ScreenUpdating = False
                Set Plage = Range(Cells(6, 1), Cells(6 + NombreJour, 1)).Resize(, 7)
                'mémorise le formatage de la colonne A puis passe la colonne A au format "Standard" pour avoir des valeurs de type Long
                'F = Plage.Columns(1).NumberFormat   'Si cette ligne de macro ne fonctionne pas appliquer la ligne ci-dessous
                If IsNull(Plage.Columns(1).NumberFormat) Then F = "dddd dd mmmm yyyy" Else F = Plage.Columns(1).NumberFormat
                Plage.Columns(1).NumberFormat = "General"
                'effectue la recherche de la date en type Long sur la colonne A
                Set Cel = Plage.Columns(1).Find(CLng(Date), , xlValues, xlWhole)
                'puis rétabli le format
                Plage.Columns(1).NumberFormat = F
                Plage.Interior.ColorIndex = 8
                'si trouvée, mets la plage au fond 8 puis colore la ligne du jour
                If Not Cel Is Nothing Then
                    Range(Cells(Cel.Row, 1), Cells(Cel.Row, Plage.Columns.Count)).Interior.ColorIndex = 17
                    J = Cel.Row - 1
                End If
                If J = 0 Then J = Plage.Rows.Count + 6
                'colore ensuite les cellules en fonction du jour
                For I = 6 To J
                    If Cells(I, 1).Value <> "" Then
                        If Application.CountIf(Sheets("Menu").Range("JOursFériés"), Range("A" & I)) > 0 Or Weekday(Range("A" & I), vbMonday) > 5 Then
                            Range("A" & I & ":G" & I).Interior.ColorIndex = 38
                        Else
                            Range("A" & I).Interior.ColorIndex = 15
                            Range("B" & I).Interior.ColorIndex = 6
                            Range("C" & I).Interior.ColorIndex = 4
                            Range("D" & I & ":G" & I).Interior.ColorIndex = 43
                        End If
                    End If
                Next I
                Application.ScreenUpdating = True
            End If
        End If
    End If
  Application.EnableEvents = True
End Sub
 

job75

XLDnaute Barbatruc
Bonjour un internaute,

Votre macro Workbook_SheetChange est un vrai capharnaüm mais bon j'y ai ajouté ceci :
Code:
        If Target.Row > 5 And Target.Row <= NombreJour + 5 Then
            If Cells(Target.Row, 1) = "" Then Cells(Target.Row, 2).Resize(, 2) = ""
            If Cells(Target.Row, 2) & Cells(Target.Row, 3) = "" Then Cells(Target.Row, 1).Resize(, 7).Interior.ColorIndex = 8
        End If
A+
 

Pièces jointes

  • TOTO(1).xls
    283 KB · Affichages: 5

Discussions similaires

Réponses
28
Affichages
1 K

Statistiques des forums

Discussions
312 199
Messages
2 086 161
Membres
103 148
dernier inscrit
lulu56