Calculer nombre de jours entre deux dates en VBS

Calculer nombre de jours entre deux dates en VBS - VB/VBA/VBS - Programmation

Marsh Posté le 08-07-2008 à 16:47:08    

Bonjour à tous,
 
Je dois écrire un script qui permet de de calculer le nombre de jours entre deux dates ( sans wekend et jours ferié).
J'ai commencé a l'ecrire avec la fonction dateDiff
intDateDiff = DateWeek("d", dtStart, dtEnd)
 
J'ai bien le résultat du nombre de jours écoulé entre les 2 dates cepadant je ne veux pas comptabilisé les weekend et jours ferié. Je ne vois vraiment pas comment procédé.
Merci à tous pour votre aide.

Reply

Marsh Posté le 08-07-2008 à 16:47:08   

Reply

Marsh Posté le 08-07-2008 à 19:53:08    

Salut , sans doute à adapter , car à l'origine c'est du VBA
Origine Code : Frédéric SIGONNEAU / Laurent LONGRE


Function NbOuvrés(D1, D2)
Dim Prem As Date, Der As Date, i As Date
    If D1 = D2 Then
        Prem = D1
        If TYPEJOUR(Prem) = 0 Then NbOuvrés = 1
        Exit Function
    End If
    Select Case D1 < D2
        Case True: Prem = D1: Der = D2
        Case False: Prem = D2: Der = D1
    End Select
    For i = Prem To Der
        NbOuvrés = NbOuvrés + (TYPEJOUR(i) = 0) * -1
    Next i
End Function
 
Private Function TYPEJOUR(D As Date)
Dim A As Integer, T As Integer
Dim LP As Date, LD As Long
Dim Toto As Long
 
    A = Year(D)
    If A > 2099 Then
        TYPEJOUR = CVErr(xlErrValue)
        Exit Function
    End If
    LD = Int(D)
    If LD <= 2 Then
        If LD = 1 Then TYPEJOUR = 2
        Exit Function
    End If
    T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
    LP = DateSerial(A, 3, 2) + T + (T > 48) _
         + 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
    Select Case D
            ' Jours fériés mobiles
        Case Is = LP, Is = LP + 38, Is = LP + 49
            TYPEJOUR = 2
            ' Jours fériés fixes
        Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
             Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
             Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
             Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
            TYPEJOUR = 2
        Case Else
            ' Samedi ou dimanche
            If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1
    End Select
End Function


 
A noter que sous VBA il existe SERIE.JOUR.OUVRE


Message édité par kiki29 le 08-07-2008 à 20:17:01
Reply

Marsh Posté le 09-07-2008 à 12:45:14    

Bonjour,
 
Merci d'avoir répondu si vite  :)  :) . Alors j'ai essayé le code que j'ai essayé d'adapter a du VBScript. et 2 question se pose. Pour que sa marche dois je appelé la fonction nbouvre() qui applera la fonction TYPEJOUR ?
 
et deuxieme question je n'arrive pas adapter le bout de code suivant :  Case Is = LP en effet le logiicel microsoft script editor me renvoi l'erreur suivante:  
[b] Erreur de syntaxe
Fichier :script.vbs
Ligne:161
Case Is = LP
[/b]
 
 
Merci beaucouuuup  
 

Reply

Marsh Posté le 09-07-2008 à 14:27:31    

Salut, voir syntaxe sur http://www.bellamyjc.org/fr/vbsinstructions.html ou  
http://www.jalix.org/ressources/in [...] ript/html/
utiliser aussi par exemple http://astase.com/produits/vbsfactory/
 
Perso sans vraiment connaitre qqch à VBS cela donne ceci , à toi de faire le reste


Option Explicit
 
Function NbOuvres(D1, D2)  
Dim Prem , Der , i
    If D1 = D2 Then  
        Prem = D1  
        If TYPEJOUR(Prem) = 0 Then NbOuvres = 1  
        Exit Function  
    End If  
    Select Case D1 < D2  
        Case True: Prem = D1: Der = D2  
        Case False: Prem = D2: Der = D1  
    End Select  
    For i = Prem To Der  
        NbOuvres = NbOuvres + (TYPEJOUR(i) = 0) * -1  
    Next  
End Function  
 
Private Function TYPEJOUR(D)  
Dim A , T  
Dim LP , LD
Dim Toto  
 
    A = Year(D)  
    If A > 2099 Then  
        TYPEJOUR = CVErr(xlErrValue)  
        Exit Function  
    End If  
    LD = Int(D)  
    If LD <= 2 Then  
        If LD = 1 Then TYPEJOUR = 2  
        Exit Function  
    End If  
    T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21  
    LP = DateSerial(A, 3, 2) + T + (T > 48) + 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)  
    Select Case D  
            ' Jours fériés mobiles  
        Case LP, LP + 38, LP + 49  
            TYPEJOUR = 2  
            ' Jours fériés fixes  
        Case DateSerial(A, 1, 1),DateSerial(A, 5, 1), _  
             DateSerial(A, 5, 8), DateSerial(A, 7, 14), _  
             DateSerial(A, 8, 15),DateSerial(A, 11, 1), _  
             DateSerial(A, 11, 11),DateSerial(A, 12, 25)  
            TYPEJOUR = 2  
        Case Else  
            ' Samedi ou dimanche  
            If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1  
    End Select  
End Function  


Message édité par kiki29 le 09-07-2008 à 14:50:31
Reply

Marsh Posté le 09-07-2008 à 16:17:33    

Un grandd mercii à toi,   :)  :)  
 
J'avai fait un peu comme toi sauf au niveau des case je ne savais pas comment les mettre en forme avec qu'il soit compatible en VBS.
Ca marche nikel il renvoi bien les bonne valeur dans mon formulaire infopath. Je met le  code pour ceux que ca interesse (legerement modifié par rapport a la tienne).
Encore une fois merci beaucoupp
 
Code :  
 
 
' FONCTION QUI CONVERTI LES DATES AU FORMAT VBS
Function ISODateStringToVBDate(ISODateString)
Dim dtRetVal
dtRetVal = Null
 
If Trim(ISODateString) <> "" Then
dtRetVal = DateSerial(Mid(ISODateString, 1, 4), _
Mid(ISODateString, 6, 2), Mid(ISODateString, 9, 2))
End If
ISODateStringToVBDate = dtRetVal  
End Function
 
Function NbOuvres()  
Dim strStartDate
Dim strEndDate
Dim strDateInterval
Dim D1  
Dim D2
Dim intDateDiff
Recuperation de la date entré dans le formulaire
strStartDate = XDocument.DOM.selectSingleNode _  
("/my:mesChamps/my:startDate" ).text
 
strEndDate = XDocument.DOM.selectSingleNode _
("/my:mesChamps/my:endDate" ).text
 
Conversion de la date infopath en date VBS
D1 = ISODateStringToVBDate(strStartDate)
D2 = ISODateStringToVBDate(strEndDate)
 
Dim Prem , Der , i  
    If D1 = D2 Then  
        Prem = D1  
         
 
        If TYPEJOUR(Prem) = 0 Then NbOuvres = 1  
        Exit Function  
    End If  
 
    Select Case D1 < D2  
 
        Case True: Prem = D1: Der = D2  
        Case False: Prem = D2: Der = D1  
    End Select  
   
    For i = Prem To Der  
        NbOuvres = NbOuvres + (TYPEJOUR(i) = 0) * -1  
    Next  
 
AFFICHAGE DU NOMBRE DE JOURS DANS LA CASE DU FORMULAIRE
   XDocument.DOM.selectSingleNode _
("/my:mesChamps/my:dateDiff" ).text = NbOuvres  
End Function  
 
 
 
 
Private Function TYPEJOUR(D)  
Dim A , T    
Dim LP , LD  
Dim Toto  
   
    A = Year(D)  
    If A > 2099 Then  
        TYPEJOUR = CVErr(xlErrValue)  
        Exit Function  
    End If  
    LD = Int(D)  
    If LD <= 2 Then  
        If LD = 1 Then TYPEJOUR = 2  
        Exit Function  
    End If  
    T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21  
    LP = DateSerial(A, 3, 2) + T + (T > 48) + 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)  
    Select Case D  
            ' Jours fériés mobiles  
        Case LP, LP + 38, LP + 49  
            TYPEJOUR = 2  
            ' Jours fériés fixes  
        Case DateSerial(A, 1, 1),DateSerial(A, 5, 1), _  
             DateSerial(A, 5, 8), DateSerial(A, 7, 14), _  
             DateSerial(A, 8, 15),DateSerial(A, 11, 1), _  
             DateSerial(A, 11, 11),DateSerial(A, 12, 25)  
            TYPEJOUR = 2  
        Case Else  
            ' Samedi ou dimanche  
            If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1  
    End Select  
End Function  
 
APPELLE DE LA FONCTION
 
Sub CTRL5_5_OnClick(eventObj)
NbOuvres
End Sub
 
 
 
 
Encore une fois merciiii  :)

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed