MFC à 5 conditions

**novice06** · 08/03/2011, 21h56

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

**kiki29** · 08/03/2011, 22h31

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/

**mercatog** · 08/03/2011, 23h26

Essaies ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**novice06** · 09/03/2011, 06h04

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**mercatog** · 09/03/2011, 12h01

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

MFC à 5 conditions [XL-2003]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager