Sujet Précédent Sujet Suivant

Une feuille par jour ouvré

Résolu
cs_anthonyo Messages postés 14 Date d'inscription mercredi 11 octobre 2006 Statut Membre Dernière intervention 14 septembre 2007 - 12 sept. 2007 à 15:48
cs_anthonyo Messages postés 14 Date d'inscription mercredi 11 octobre 2006 Statut Membre Dernière intervention 14 septembre 2007 - 14 sept. 2007 à 08:50
Bonjour,

J'aimerai un  peu d'aide pour créer une feuille pour chaque jour ouvré de l'année.

Voici le code qui me créé une feuille mais pour chaque jour de l'année saisie en inputbox:

Sub Calendjourfeuille()
Application.ScreenUpdating = False
année = Val(InputBox("Quelle année ?"))
If année = 0 Then Exit Sub
x = DateSerial(année, 1, 1)
y = DateValue("31 décembre " & année)
For I = 0 To y - x
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(x + I, "dd-mm-yy")
Next
End Sub

Comment faire pour ne retenir que les jours ouvrés?
Merci pour votre aide

4 réponses

Réponse 1 / 4
mrdep1978 Messages postés 402 Date d'inscription jeudi 25 novembre 2004 Statut Membre Dernière intervention 7 juin 2009 7
12 sept. 2007 à 18:01
Salut,

Pour les week-end, tu peux utiliser la fonction DatePart pour identifier à quelle jour de la semaine correspondent chacune de tes dates
Ex :
'Si le jour n'est ni un samedi (6), ni un dimanche (7)
If Datepart("w", maDate, vbMonday) < 6 Then
   'Je crée ma feuille
End If

Pour les jours fériés, du type lundi de pâques, jeudi de l'ascencion ..., il parait qu'il y a de superbes formules mathématiques, mais je ne sais plus lesquelles.

Sinon, petits conseils en vrac :
- Evite les accents dans tes noms de variables (année -> annee) (risque de coincer avec un Windows non français)- Remplace "y DateValue("31 décembre " & année) " par "y DateSerial(annee, 12, 31)" (risque de coincer sur un PC utilisant un autre format de date)
3
Réponse 2 / 4
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 27
13 sept. 2007 à 00:13
 Bonsoir à tous,

Je n'ai fait qu'adapter un script, trouvé en vb6, sur l' algorithme de Oudin.
Testé en vbs et donc à ré-adapter pour vb6 + la partie Excel.

Option explicit

Dim Annee, DateDeb, DateFin, NbreJours,i
Annee = 2007

DateDeb = DateSerial(Annee, 1, 1) 
DateFin = DateSerial(Annee+1, 1, 1 - 1) 
NbreJours = DateDiff("d",DateDeb, DateFin)

For i=0 To NbreJours
    If IsFerie(DateSerial(Annee, 1, 1+i)) = False Then
       'ici écriture Excel ou autre
        MsgBox DateSerial(Annee, 1, 1+i) &vbCrLf& _
               IsFerie(DateSerial(Annee, 1, 1+i)),, _
               "IsFerie = False , jour ouvré"
    End If   
Next

Private Function IsFerie(datetoanalyse)           'As Date) As Boolean
    Dim jour, Mois, Annee, Ascension, Pentecote, Paques 'As Integer
    Dim G, C, C_4, E, H, k, P, Q, i, B, J1, J2    'As Integer

    If DatePart("w", CDate(datetoanalyse)) = vbSaturday Or _
       DatePart("w", CDate(datetoanalyse)) = vbSunday Then
       IsFerie = True : Exit Function
    End if 
 
    jour = Day(datetoanalyse)
    Mois = Month(datetoanalyse)
    Annee = Year(datetoanalyse)
  
    'Calcul des jours fériés "non fixes" (Lundi de Pâques, Ascension, Pentecôte)
    'Lundi de Pâques (Algorithme de Oudin)
    G = (Annee Mod 19)
    C = Fix(Annee / 100)
    C_4 = Fix(C / 4)
    E = Fix((8 * C + 13) / 25)
    H = Fix((19 * G + C - C_4 - E + 15) Mod 30)
    k = Fix(H / 28)
    P = Fix(29 / (H + 1))
    Q = Fix((21 - G) / 11)
    i = ((k * P * Q - 1) * k + H)
    B = (Fix(Annee / 4) + Annee)
    J1 = (B + i + 2 + C_4 - C)
    J2 = (J1 Mod 7)
  
    'Ici on obtient le jour de Pâques (dimanche), on lui ajoute 1 pour avoir le jour du lundi
    paques = 28 + i - J2 + 1
  
    'Ascension
    Ascension = paques - 23
  
    'Pentecôte
    Pentecote = paques - 12
  
    Select Case Mois
        Case 1
            'Jour de l'An            If jour 1 Then IsFerie True
        Case 3
            'Pâques si paques<=31
            If paques <= 31 Then                If jour paques Then IsFerie True
            End If
        Case 4
            'Pâques si paques>31
            If paques > 31 Then
                paques = paques - 31                If jour paques Then IsFerie True
            End If
        Case 5
            'Fête du travail, Victoire, Ascension et Pentecôte            If jour 1 Or jour 8 Or jour = Ascension Or jour = Pentecote Then IsFerie = True
        Case 7
            'Fête Nationale            If jour 14 Then IsFerie True
        Case 8
            'Assomption            If jour 15 Then IsFerie True
        Case 11
            'Toussaint et Armistice            If jour 1 Or jour 11 Then IsFerie = True
        Case 12
            'Noël            If jour 25 Then IsFerie True
        Case Else
            IsFerie = False
    End Select
End Function

jean-marc
0
Réponse 3 / 4
cs_anthonyo Messages postés 14 Date d'inscription mercredi 11 octobre 2006 Statut Membre Dernière intervention 14 septembre 2007
13 sept. 2007 à 09:38
Ok, je teste cela et je reviens vers vous!

Merci!
0
Réponse 4 / 4
cs_anthonyo Messages postés 14 Date d'inscription mercredi 11 octobre 2006 Statut Membre Dernière intervention 14 septembre 2007
14 sept. 2007 à 08:50
Merci pour votre aide!

JMO, j'ai pris ton code et je le garde sous le coude; j'ai pas encore eu le tps de l'adapter!
0

Discussions similaires

Copier feuille excel dans un autre classeur sans l'ouvrir vb excel
erti1711 -
erti1711 -

4 réponses
macro, supprimer une feuille Excel SANs confirmation...
Bruno_65 -
Bruno_65 -

2 réponses
Excel - Interdire le déplacement d'une feuille
jesuhsXVII -
jesuhsXVII -

7 réponses
[vba] recopier la valeur d'une cellule dans une autre feuille.
cokinoumasterflash -
cokinoumasterflash -

5 réponses
Code VB : suppression d'une feuille excel si elle existe
cs_malika_i -
Nicko11 -

11 réponses
Rejoignez-nous