Excel VBA - durée à cheval sur 2 années

Version imprimable

Bonjour,
Je dois réaliser un planning avec des dates début et fin de stage. Pour colorier le planning j'utilise les numéros de semaine de chacun des dates (col H pour la sem 1 jusqu'à col BG pour la sem 52).
Voici un bout du code qui fonctionne parfaitement écrit par Mercatog, mille mercis.

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
            'j compteur de ligne débute en 4 dans la feuille planning
            For j = 4 To LastLig
                'date de début en colonne D
                v_date_stage = CDate(.Range("D" & j).Value)
                'date fin en colonne F
                v_date_fin_stage = CDate(.Range("F" & j).Value)
                'N° semaine de de début
                v_sem_deb = DatePart("ww", v_date_stage, vbMonday, vbFirstFourDays)
                'N° semaine fin
                v_sem_fin = DatePart("ww", v_date_fin_stage, vbMonday, vbFirstFourDays)
                'on écrit en E le n° semaine de  début
                .Range("E" & j).Value = v_sem_deb
                'on écrit en G le n° semaine de  fin
                .Range("G" & j).Value = v_sem_fin
                'On boucle et en remplit (semaine 1 en colonne 8:H
                'If v_sem_deb > v_sem_fin Then
                    For i = v_sem_fin To v_sem_deb 'j'ai essayé ce test mais bof !
                        .Cells(j, 7 + i).Value = Left(.Range("C" & j).Value, 1)
                        'Si le service est colorié en colonne C,
                        'cette couleur sera reportée dans le planning
                        .Cells(j, 7 + i).Interior.Color = .Range("C" & j).Interior.Color
                        Next i
                Else
                    For i = v_sem_deb To v_sem_fin
                        .Cells(j, 7 + i).Value = Left(.Range("C" & j).Value, 1)
                        'Si le service est colorié en colonne C,
                        'cette couleur sera reportée dans le planning
                        .Cells(j, 7 + i).Interior.Color = .Range("C" & j).Interior.Color
                    Next i
                'End If
            Next j

Le souci est lorsque le stage commence par exemple en novembre et se termine en janvier, dans ce cas le numéro de la semaine fin est supérieur à celle de début.

Merci encore pour votre aide.
Chris

06/04/2011, 13h35
batou22003

mise en forme conditionnelle

il n'y aurait pas plus simple avec une mise en forme conditionnelle?

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
Dim Dd As Date, Df As Date
Dim LastLig As Long, j As Long
Dim i As Byte, Ofst As Byte, Sd As Byte, Sf As Byte
 
 
With Sheets("planning")
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    With Range("H4:CI" & LastLig)
        .ClearContents
        .Interior.ColorIndex = xlNone
    End With
    For j = 4 To LastLig
        Dd = CDate(.Range("D" & j).Value)
        Df = CDate(.Range("F" & j).Value)
        If Year(Df) = Year(Dd) + 1 Then Ofst = DateDiff("ww", DateSerial(Year(Dd), 1, 1), DateSerial(Year(Df), 1, 1))
        Sd = DatePart("ww", Dd, vbMonday, vbFirstJan1)
        Sf = DatePart("ww", Df, vbMonday, vbFirstJan1)
        .Range("E" & j).Value = Sd
        .Range("G" & j).Value = Sf
        For i = Sd To Sf + Ofst
            .Cells(j, 7 + i).Value = Left(.Range("C" & j).Value, 1)
            .Cells(j, 7 + i).Interior.Color = .Range("C" & j).Interior.Color
        Next i
        Ofst = 0
    Next j
End With

Edit: j'ai modifié le code avec la semaine du 1er janvier est la semaine n°1 (en ne tenant pas compte de la norme ISO)

pour corriger ton code

Fais comme suit , tu rajoutes
un test et 2 boucles
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 'cas 1 : cas idéal if v_sem_fin>=v_sem_deb then else 'cas génant , considérer 2 bouts à traiter for i= 1 to v_sem_fin 'coloriage next for i= v_sem_deb to 52 'coloriage next end if
Je crois que cela devrait résoudre ton problème.

:)

06/04/2011, 17h45
chris_ij32

Gestion de stagiaires par service avec planning sur2 ans

Vous êtes des chefs ça marche nickel, j'ai conservé la version de mercatog.
Encore merci beaucoup
Voila une application de gestion de stagiaires par service avec planning qui devrait être sympa grâce à vous.
À bientôt pour de nouvelles aventures
Bien cordialement
Chris
ps : si vous voulez le fichier terminé n'hésitez pas !
Il me reste à peaufiner mes formulaires et j'espère que cela sera une formalité:roll: