Discussion :

[pascb423]

Bonjour, j'ai modifié un code que j'ai recu du forume pour que ca calcul le nombre de vendredi entre 2 dates( et que si la date de départ ou la date d'arrivée est un vendredi ca ne le compte pas) mais ca ne compte pas juste.
vous pouvez me dire ou il y a l'erreur, merci

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
Function vendredi(d1, d2) As Integer 'compte les lundi ou mardi ou ect entre 2 dates
        Dim ret, daysbetween
        daysbetween = DateDiff("d", d1, d2)
        ret = Int(daysbetween / 7)
        daysbetween = daysbetween - (7 * ret)
        'le 6 est le jour de la semaine= vendredi   lundi 2 mardi 3 mercredi 4 jeudi 5 samedi 7 dimanche 1
        If (((Weekday(d1) Mod 7) + daysbetween) = 6) Then ret = ret + 1
        vendredi = ret
        If (((Weekday(Form1.TextBox12.Text) Mod 7) + daysbetween) = 6) Then
            vendredi = ret - 1
        End If
        If (((Weekday(Form1.TextBox13.Text) Mod 7) + daysbetween) = 6) Then
            vendredi = ret - 2
        End If
        If vendredi < 0 Then vendredi = 0
    End Function

[pascb423]

j'ai trouvé une solution qui fonctionne, la voici:

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
Function vendredi(d1, d2) As Integer 'compte les lundi ou mardi ou ect entre 2 dates
        Dim ret As Integer
        For i As Integer = 0 To DateDiff(DateInterval.Day, d1, d2)
 
            If DateAdd(DateInterval.Day, i, d1).DayOfWeek = DayOfWeek.Friday Then
                ret = ret + 1
            End If
        Next
 
        Dim TestDateTime As Date = d1
        Dim TestStr As String
        TestStr = Format(TestDateTime, "dddd")
        Dim TestDateTime2 As Date = d2
        Dim TestStr2 As String
        TestStr2 = Format(TestDateTime2, "dddd")
        If TestStr = "vendredi" Then
            ret = ret - 1
        End If
        If TestStr2 = "vendredi" Then
            ret = ret - 1
        End If
        'If samedi() < 0 Then samedi = 0
        vendredi = ret
    End Function