VBA ajouter n jours ouvrés à la date du jour

[C@thy]

Bonjour le forum,

je cherche à mettre dans une cellule la date du jour + 5 jours ouvrés

Function fer(an%) 'liste de tous les jours fériés
Dim pq
  pq = paq(an)
  fer = Array(DateSerial(an, 1, 1), DateSerial(an, 5, 1), DateSerial(an, 5, 8), DateSerial(an, 7, 14), DateSerial(an, 8, 15), DateSerial(an, 11, 1), DateSerial(an, 11, 11), DateSerial(an, 12, 25), pq + 1, pq + 39, pq + 50)
End Function


Function paq(a%, Optional T As Boolean = False) 'Calcul date de Pâques
Dim g&, c&, d&, h&, I&, r&
  paq = ""
  If a > 1582 Then
    g = a Mod 19
    c = Int(a / 100)
    d = Int(c / 4)
    h = (19 * g + c - d - Int((8 * c + 13) / 25) + 15) Mod 30
    I = (Int(h / 28) * Int(29 / (h + 1)) * Int((21 - g) / 11) - 1) * Int(h / 28) + h
    r = DateSerial(a - 400 * (a < 1900), 3, 28) + I - (2 + a + Int(a / 4) + I + d - c) Mod 7
    If T Then
      paq = IIf(Day(r) = 1, "1er", Day(r)) & " " & IIf(r > 3, "avril", "mars") & " " & a
    Else
      paq = Day(r) & "/" & Month(r) & "/" & a
      If a > 1899 Then paq = CDbl(CDate(paq))
    End If
  End If
End Function

Et c'est là que ça se corse :

dans une cellule je dois ajouter 5 jours ouvrés et dans une autre ... six semaines ouvrées!😱🙄

Sub AjouterJoursOuves()
Dim an As Integer, I As Integer
Dim N, fr

an = Year(Date)
fr = fer(an)

N = Date + 1
For I = 0 To UBound(fr)
     If N = fr(I) Then
...
...
end sub

Si vous pouviez m'apporter votre aide je vous serai infiniment reconnaissante🙂😎
Merci à vous

Bises

C@thy

 

[Guest]

Re : VBA ajouter n jours ouvrés à la date du jour

Re,

Je ne comprends pas ce que je dois faire du fichier que tu me donnes😕. Si c'est pour corriger les macros, joint celles-ci avec.

A+

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

Tout s'explique!

J'avais remarqué cette anomalie, mais je ne savais pas que c'était ça qui gênait

Le fichier c'est juste un pense-bête pour moi, pour savoir quel jour ça donne 6 semaines ouvrées plustard.

Merci

Edit OK, j'ai compris :

c'est mieux comme ça?

Function Paq(ByVal an As Integer) As long
Paq = CLng(DateSerial(an, 3, 23)) + ((2 * (an Mod 4) + (4 * (an Mod 7) + _
   (6 * (((19 * (an Mod 19)) + 24) Mod 30) + 5))) Mod 7) + _
   ((19 * (an Mod 19) + 24) Mod 30) - 1
End Function

Bsx

C@thy

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

Ca y est, j'y suis, j'ai cerné le problème :

pour le 1/11 et le 11/11

InStr(1, strférié, CStr(d) & ";") renvoie 0 alors que d est bien 40848 (et 40858) et strférié comporte bien 40848 et 40858
strférié : "40544;40664;40671;40738;40770;40848;40858;40902;40658;40696;40707"

C@thy

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

J'ai trouvé!!!

il y a strFériés et dans instr on met strférié sans s!!

 

[Guest]

Re : VBA ajouter n jours ouvrés à la date du jour

Re,

Eh oui, bougre d'âne que je suis, comme je n'avais pas testé, avais point vu la phôte😎 Sorry.

C@thy ou les malheurs du copier/coller (mon prochain roman - edition dans 60 ans jour pour jour, promis🙂)

A+

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

C'est moi, la bougre d'ânesse!!! J'ai mis du temps à le voir...

d'où l'utilité du Option explicit (Ti me l'avait pourtant bien dit!!!)

Pour ton best-seller, j'ai encore un truc sur lequel je me suis penchée...🙂

c'est que la boucle for

For cpt = objInbox.Items.Count To 1 Step -1

me met le courrier le + récent en 1er, si je fais ça toutes les semaines ou tous les mois ça va vite être un peu fouillis...
j'ai essayé de la faire à l'envers (for cpt = 1 to objInbox.Items.Count) mais ça marche pas...

je vais faire celle qui n'a rien vu😎, je présente l'appli lundi, et on verra bien si ils tiquent ou pas (les zutilisateurs)...😱😱😱

Bises

C@thy

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

Bonjour le forum,

je réactive ce fil (fort intéressant pour moi et qui m'a apporté bien des réponses utiles)

je cherche à calculer en VBA le nombre de jours ouvrés entre 2 dates, sachant que j'ai déjà les fonctions suivantes :

Function Paq(ByVal an As Integer) As Date
Paq = DateSerial(an, 3, 23) + ((2 * (an Mod 4) + (4 * (an Mod 7) + _
   (6 * (((19 * (an Mod 19)) + 24) Mod 30) + 5))) Mod 7) + _
   ((19 * (an Mod 19) + 24) Mod 30) - 1
End Function

Function Fer(an%) 'liste de tous les jours fériés
Dim pq
pq = Paq(an)
Fer = Array(CLng(DateSerial(an, 1, 1)), CLng(DateSerial(an, 5, 1)), CLng(DateSerial(an, 5, 8)), CLng(DateSerial(an, 7, 14)), CLng(DateSerial(an, 8, 15)), CLng(DateSerial(an, 11, 1)), CLng(DateSerial(an, 11, 11)), CLng(DateSerial(an, 12, 25)), CLng(pq) + 1, CLng(pq) + 39, CLng(pq) + 50)
End Function

Function GetDateOuvrée(ByVal d As Long, Fer As Variant, Optional incr As Integer = 1) As Long
Do While Not IsError(Application.Match(CLng(d), Fer, 0)) Or Weekday(d) = 1 Or Weekday(d) = 7
d = d + incr
Loop
GetDateOuvrée = d
End Function

Function AJouteJoursOuvrés(ByVal d As Long, nbJours As Integer, Fer As Variant) As Long 'calcul ajout de jours ouvrés
    Dim I As Integer, bAjoute As Boolean
    'StrFériés contiendra une chaine de tous les jours fériés séparés par un point virgule
    Dim strFériés As String: strFériés = Join(Fer, ";")
    For I = 1 To nbJours
        d = d + 1
        'Si d est un dimanche ou Samedi ou s'il est trouvé daobjNS strFériés alors ajourter un jour
        Do While Weekday(d) = 1 Or Weekday(d) = 7 Or InStr(1, strFériés, CStr(d) & ";") > 0
            d = d + 1
        Loop
    Next
    AJouteJoursOuvrés = d
End Function

J'ai fait moulte recherches sur le forum mais je ne dois pas donner les bons mots clés🙄 car à chaque fois je trouve des formules...

je pense qu'il faut rebidouiller la fonction AjouteJoursOuvres pour faire une fonctions CalculeJoursOuvres
(je préfère parler de jours ouvrés que de jours travaillée, c'est mons douloureux... Niark!!!)

Merci à vous

C@thy

 

[roro69]

Re : VBA ajouter n jours ouvrés à la date du jour

Bonjour
Un petit classeur a essayer
A++

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

je te remercie, roro69,
je crois qu'à chaque fois il y a un jour de trop,

si je mets 31/12/2009 et 4/1/2010 il doit me donner 1 jour mais il renvoie 2
pareil si je mets 30/12/2009 et 31/12/2009

Bises

C@thy

 

[JCGL]

Re : VBA ajouter n jours ouvrés à la date du jour

Bonjour à tous,

Il me semble que du mercredi 30/12/2009 au jeudi 31/12/2009 il y ait bien deux jours ouvrés...
Et chez moi jeudi 31/12/2009 au lundi 04/01/2010 renvoie un jour.

A+ à tous

 

[roro69]

Re : VBA ajouter n jours ouvrés à la date du jour

RE
ne serait ce pas les jour Ouvrables que tu voudrait..........
A++

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

Coucou JC,

je fais la différence entre 2 dates, c'est à dire le temps écoulé, donc pour moi,
du jour n (30/12/2009) au lendemain (31/12/2009) cela doit renvoyer un jour de différence, comme quand tu soustrais 2 dates...

Euh roro... je veux la différence entre des jours travaillés (le we on ne travaille pas chez nous...),
ça te va comme ça?


Bises

C@thy

 

[JCGL]

Re : VBA ajouter n jours ouvrés à la date du jour

Bonjour à tous,
Re Cathy,
Salut Roro,

Pour XL et les dates, il prend l'heure à 00:00 donc à adapter à ton souhait par un -1

Bises+
A+ tous

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

donc à adapter à ton souhait par un -1

C'est juste, JC.

Je pense qu'il y avait moyen de faire avec mes fonctions (déjà prêtes dans mon classeur), sans en rajouter,
c'est ce que je cherchais à faire.

Bizz

C@thy

 

[C@thy]

Re : VBA ajouter n jours ouvrés à la date du jour

En fait, je ne récupère pas le résultat dans une cellule mais dans une variable...

Bises

C@thy