Discussion :

[zangaloni]

Bonjour,
J'ai besoin d'enlever les week end en premier temps et après les jours férié de mon calendrier d'un an.
Les dates je les ai sur ma feuille excel bien sur.
Y a-t-il un moyen rapide de faire ceci avec excel ??

[kiki29]

Salut,la réponse est oui via Formules et VBA, mais cela dépendra de la façon dont se présente ton calendrier.

[kiki29]

Re,un calendrier "bestial" en VBA sur la colonne A, sans Samedi, Dimanche ni Jours Fériés, avec une plage nommée "Annee"

Lancer ensuite la procédure Calendrier

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 
Option Explicit
 
Dim JFeries(11) As Long
Dim LastRow As Long
 
Sub Calendrier()
Dim Depart As Long, Fin As Long, i As Long, j As Long
Dim iR As Long
 
    Feuil1.Columns(1).Clear
 
    Application.ScreenUpdating = False
    Depart = CDate("1/1/" & Feuil1.Range("Annee"))
    Fin = CDate("31/12/" & Feuil1.Range("Annee"))
 
    iR = 1
    For i = Depart To Fin
        Feuil1.Cells(iR, 1).Value = i
        iR = iR + 1
    Next i
 
    JoursFeries Feuil1.Range("Annee")
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
 
    For i = LastRow To 1 Step -1
        For j = 1 To 11
            If Feuil1.Cells(i, 1) = JFeries(j) Or Weekday(Feuil1.Cells(i, 1)) = vbSaturday Or Weekday(Feuil1.Cells(i, 1)) = vbSunday Then
                Feuil1.Range("A" & i).Delete Shift:=xlUp
                Exit For
            End If
        Next j
    Next i
 
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    Feuil1.Range("A1:A" & LastRow).NumberFormatLocal = "jjj jj mmm aa"
    Application.ScreenUpdating = True
End Sub
 
Private Function JoursFeries(An As Long)
Dim Nb As Long, Epacte As Long
Dim PLune As Date, LPaques As Date
Dim i As Long, j As Long, k As Long, tmp As Long
 
    '   Calcul du Lundi de Pâques
    Nb = (An Mod 19) + 1
    '   Différence entre calendrier solaire et lunaire
    Epacte = (11 * Nb - (3 + Int(2 + Int(An / 100)) * 3 / 7)) Mod 30
    PLune = DateSerial(An, 4, 19) - ((Epacte + 6) Mod 30)
    If Epacte = 24 Then PLune = PLune - 1
    If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
 
    '   Lundi de Pâques
    LPaques = PLune - Weekday(PLune) + vbMonday + 7
 
    Erase JFeries
    '   Jour de l'An
    JFeries(1) = DateSerial(An, 1, 1)
    '   Paques
    JFeries(2) = LPaques
    '   Ascension
    JFeries(3) = LPaques + 38
    '   Pentecôte
    JFeries(4) = LPaques + 49
 
    '   Fete du travail
    JFeries(5) = DateSerial(An, 5, 1)
    '   Anniversire 1945
    JFeries(6) = DateSerial(An, 5, 8)
    '   Fete Nationale
    JFeries(7) = DateSerial(An, 7, 14)
    '   Assomption
    JFeries(8) = DateSerial(An, 8, 15)
    '   Toussaint
    JFeries(9) = DateSerial(An, 11, 1)
    '   Armistice 1918
    JFeries(10) = DateSerial(An, 11, 11)
    '   Noel
    JFeries(11) = DateSerial(An, 12, 25)
 
    '   Tri
    For i = 1 To UBound(JFeries)
        j = i
        For k = j + 1 To UBound(JFeries)
            If JFeries(k) <= JFeries(j) Then j = k
        Next k
        If i <> j Then
            tmp = JFeries(j)
            JFeries(j) = JFeries(i)
            JFeries(i) = tmp
        End If
    Next i
End Function

[zangaloni]

Merci pour votre aide

[kiki29]

Salut au questionneur inconnu, il semble que des posts se soient perdus après un Backup/Restore ou je ne sais quelle maintenance inappropriée.

Pour répondre à une question concernant une exécution automatique et un positionnement sur une date au démarrage, voici la réponse qui avait été apportée

A placer dans ThisWorkbook

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
25
26
27
Option Explicit
 
Private Sub Workbook_Open()
    With Feuil1
        .Activate
        .Range("A1").Select
        .Columns("A:A").Interior.ColorIndex = xlNone
    End With
    RchDate
End Sub
 
Private Sub RchDate()
Dim LastRow As Long, c As Range
 
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    With Feuil1.Range("A1:A" & LastRow)
        Set c = .Find(What:=Date, After:=ActiveCell, LookIn:=xlFormulas, SearchDirection:=xlNext, MatchCase:=True)
        If Not c Is Nothing Then
            With c.Offset(-1)
                .Select
                .Interior.ColorIndex = 36
            End With
        Else
            MsgBox "la Date Courante -1" & vbCrLf & "correspond à un Samedi, Dimanche ou Jour Férié", vbInformation + vbOKOnly, "Attention"
        End If
    End With
End Sub