MFC à 5 conditions

Version imprimable

08/03/2011, 21h56
novice06

1 pièce(s) jointe(s)

MFC à 5 conditions

bonsoir,

sur un tableau type calendrier zone D1:AI61 j'aimerais traiter par différentes couleur des périodes définies

en jaune le samedi
en vert le dimanche
en gris les jours fériés
en bleu l'été
en marron les pvs (petites vacances scolaires)

j'ai codé un vba plutôt brut et basique essayant de traiter mes problèmes mais je me retrouve forcemment bloqué ne sachant pas relier par code une date donnée à une plade de dates correspondant à une période

pourriez-vous m'aider svp ?

exemple concret :

-les jours fériés qui sont dans mon onglet en zone J64:J74
commen faire en sorte que les jours fériés correspondant se retrouve coloré dans ma zone calendrier ?

-même problèmatique mais pour l'été et les pvs en zone N64:L68 qui sont eux par contre délimités par des dates de début et de fin de validité ?

merci par avance

bonne soirée
08/03/2011, 22h31
kiki29

salut, voir dans la FAQ http://excel.developpez.com/faq/?page=mefc et pour plus de 3 formats http://www.developpez.net/forums/d48...e-p-3-formats/

Essaies ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Private Sub CommandButton1_Click()
Dim DerLigne As Long, j As Long
Dim DerCol As Integer, i As Integer
Dim Flag As Boolean
 
Application.ScreenUpdating = False
With Sheets("Calendrier_base")
    DerLigne = .Cells(.Rows.Count, "D").End(xlUp).Row
    DerCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 5), .Cells(DerLigne, DerCol)).Interior.ColorIndex = xlNone
    j = 2
    Do
        For i = 5 To DerCol
            If .Cells(j, i).Value <> "" Then
                If Not Flag Then
                    Select Case Weekday(.Cells(j, i).Value, vbMonday)
                        Case 6: .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 27
                        Case 7: .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 35
                    End Select
                    Set c = .Range("J64:J74").Find(CDate(.Cells(j, i).Value), LookIn:=xlValues, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        Set c = Nothing
                        .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 15
                    End If
                Else
                    Select Case .Cells(j, i)
                        Case "G": .Range(.Cells(j - 1, i), .Cells(j - 2, i)).Interior.ColorIndex = 45
                        Case "D": .Range(.Cells(j - 1, i), .Cells(j - 2, i)).Interior.ColorIndex = 42
                    End Select
                End If
            End If
        Next i
        j = j + 2
        If Flag Then j = j + 1
        Flag = Not Flag
    Loop Until j >= DerLigne
End With
End Sub

1 pièce(s) jointe(s)

merci mercatog ça fonctionne parfaitement

je vais prendre le temps de comprendre le code maintenant

finalement je me retrouve devant un problème si pour chaque mois j'insère une ligne supplémentaire après les 2 lignes concernées par la colorisation.

je pensais que cela se passait en bout de code

Code:

1
2
3
 j = j + 2
        If Flag Then j = j + 1
        Flag = Not Flag

mais même en incrémentant j cela bloque

là j'ai laissé tel quel mais aimerais savoir comment faire ?

merci par avance

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub CommandButton1_Click()
Dim DerLigne As Long, j As Long
Dim DerCol As Integer, i As Integer
Dim Flag As Boolean
 
With Sheets("Calendrier_base")
    DerLigne = .Cells(.Rows.Count, "D").End(xlUp).Row
    DerCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 3), .Cells(DerLigne, DerCol)).Interior.ColorIndex = xlNone
    j = 2
    Do
        For i = 3 To DerCol
            If .Cells(j, i).Value <> "" Then
            Debug.Print .Cells(j, i)
            Debug.Print Weekday(.Cells(j, i), vbMonday)
                If Not Flag Then
                    Select Case Weekday(.Cells(j, i).Value, vbMonday)
                        Case 6: .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 27
                        Case 7: .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 35
                    End Select
                    Set c = .Range("H78:H88").Find(CDate(.Cells(j, i).Value), LookIn:=xlValues, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        Set c = Nothing
                        .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 15
                    End If
                Else
                    Select Case .Cells(j, i)
                        Case "G": .Range(.Cells(j - 1, i), .Cells(j - 2, i)).Interior.ColorIndex = 45
                        Case "U": .Range(.Cells(j - 1, i), .Cells(j - 2, i)).Interior.ColorIndex = 45
                        Case "D": .Range(.Cells(j - 1, i), .Cells(j - 2, i)).Interior.ColorIndex = 42
                    End Select
                End If
            End If
        Next i
        j = j + 2
        If Flag Then j = j + 1
        Flag = Not Flag
    Loop Until j >= DerLigne
    Cells(1, 1).Select
End With
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Private Sub CommandButton1_Click()
Dim DerLigne As Long, j As Long
Dim DerCol As Integer, i As Integer
Dim Flag As Boolean
 
With Sheets("Calendrier_base")
    DerLigne = .Cells(.Rows.Count, "D").End(xlUp).Row
    DerCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 3), .Cells(DerLigne, DerCol)).Interior.ColorIndex = xlNone
    j = 2
    Do
        For i = 3 To DerCol
            If .Cells(j, i).Value <> "" Then
                If Not Flag Then
                    Select Case Weekday(.Cells(j, i).Value, vbMonday)
                        Case 6: .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 27
                        Case 7: .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 35
                    End Select
                    Set c = .Range("H78:H88").Find(CDate(.Cells(j, i).Value), LookIn:=xlValues, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        Set c = Nothing
                        .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 15
                    End If
                Else
                    Select Case .Cells(j, i)
                        Case "G", "U": .Range(.Cells(j - 1, i), .Cells(j - 2, i)).Interior.ColorIndex = 45
                        Case "D": .Range(.Cells(j - 1, i), .Cells(j - 2, i)).Interior.ColorIndex = 42
                    End Select
                End If
            End If
        Next i
'ICI on va se déplacer de 2 lignes en bas si on est en première ligne du mois, sinon de 4 lignes pour se retrouver en première ligne du mois suivant
        j = j + 2                   'On passe à 2lignes plus bas du tableau
        If Flag Then j = j + 2      'si Flag=True signifie on doit ajouter encore 2lignes pour passer à la première ligne du mois suivant
        Flag = Not Flag
    Loop Until j >= DerLigne
End With
End Sub

1 pièce(s) jointe(s)

bonjour,

je réouvre finalement, une dernière fois je pense, ce post...étant donné que j'aimerais quand même soulever une autre problématique.

est-ce que sur le même principe des jours fériés
Code:

1 2 3 4 5 Set c = .Range("J64:J74").Find(CDate(.Cells(j, i).Value), LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then Set c = Nothing .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 15 End If
on pourrait envisager de traiter les pvs de la même manière ?

les pvs sont regroupé dans le tableau zone L63:N67;
la principale différence est que chaque petite vacance scolaire est délimité par une date de début et une date de fin.

dans l'absolu cela voudrais dire que si la date traité est inclus entre la date debut et date fin de la pvs1 alors mise en couleur, puis attendre de tomber sur une date qui entre dans l'inclusion pvs2, ainsi de suite...

y-a-t'il un moyen de coder cela ?

merci par avance

bonne journée

1 pièce(s) jointe(s)

bonjour,

en balance j'essayais également de trouver une autre méthode qui pourtant me semblait cohérente mais qui ne donne pas le résultat escompté !?

Code:

1
2
3
4
5
6
7
8
9
10
val = .Cells(j, i)
                plage = Sheets("BDD").Range("A5:H370")
                donnees = WorksheetFunction.VLookup(val, plage, 5, 1)
                Debug.Print val, donnees
 
                    Select Case donnees
                        Case "pvs": .Cells(j + 2, i).Interior.ColorIndex = 45
                        Case "été": .Cells(j + 2, i).Interior.ColorIndex = 42
                        Case "férié": .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 15
                    End Select

serait-il possible de m'éclairer également sur le problème de ce code ci-dessous ?

merci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Dim DerLigne As Long, j As Long
Dim DerCol As Integer, i As Integer
Dim Flag As Boolean
Dim val As Variant, donnees As Variant, plage As Variant
 
With Sheets("Calendrier_base")
    DerLigne = .Cells(.Rows.Count, "D").End(xlUp).Row
    DerCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 3), .Cells(DerLigne, DerCol)).Interior.ColorIndex = xlNone
    j = 2
    Do
        For i = 3 To DerCol
            If .Cells(j, i).Value <> "" Then
                If Not Flag Then
                    Select Case Weekday(.Cells(j, i).Value, vbMonday)
                        Case 6: .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 27
                        Case 7: .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 35
                    End Select
 
                val = .Cells(j, i)
                plage = Sheets("BDD").Range("A5:H370")
                donnees = WorksheetFunction.VLookup(val, plage, 5, 1)
                Debug.Print val, donnees
 
                    Select Case donnees
                        Case "pvs": .Cells(j + 2, i).Interior.ColorIndex = 45
                        Case "été": .Cells(j + 2, i).Interior.ColorIndex = 42
                        Case "férié": .Range(.Cells(j, i), .Cells(j + 1, i)).Interior.ColorIndex = 15
                    End Select
                End If
            End If
        Next i
'on va se déplacer de 2 lignes en bas si on est en première ligne du mois, sinon de 4 lignes pour se retrouver en première ligne du mois suivant
        j = j + 2                   'On passe à 2lignes plus bas du tableau
        If Flag Then j = j + 2      'si Flag=True signifie on doit ajouter encore 2lignes pour passer à la première ligne du mois suivant
        Flag = Not Flag
    Loop Until j >= DerLigne
End With