Discussion :

[sickos]

Hello tout le monde,

Je suis confronté à un petit problème depuis quelques jours et je n'arrive toujours pas à trouver la solution.

Je dispose de deux fichiers sources dans un dossier "Test" que l'on notera ABC_3103 et XYZ_31032016

J'ai créer une macro qui me permet de copier - coller ces deux fichiers présents dans le dossier "Test" et qui les renomme de manière à obtenir un fichier pour chaque jour ouvré du mois suivant. En exemple cela donne:
ABC_0104
XYZ_01042016
ABC_0404
XYZ_04042016
....
ABC_2904
XYZ_29042016

Ensuite, je stipule à cette macro qu'elle doit prendre le dernier jour ouvré du mois précédent ici, le 29/04 du mois d'Avril et de créer le mois de Mai.
Mais je rencontre un problème. En effet, le premier jour ouvré du mois de Mai est un 2 Mai et la macro cherche indéfiniment le 01/05 pour créer le 02/05..
Je voudrais donc que cette macro s'adapte à chaque mois quel que soit le cas de figure rencontré.

Pourriez-vous m'aider ?

Cordialement

[eriiic]

Bonjour,

avec Dir() tu peux tester l'existence d'un fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
if Dir("D:\tmp\ABC_0104.txt") = "" then
  ' n'existe pas
else
  ' existe
endif

eric

[kiki29]

Salut, ceci pour une année ou un mois, à adapter à ton contexte

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
Option Explicit
 
Dim JFeries(10) As Long
 
Private Sub 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
    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
    '   Valable entre 1900 et 2199 ?
    If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
 
    LPaques = PLune - Weekday(PLune) + vbMonday + 7
 
    Erase JFeries
 
    JFeries(0) = DateSerial(An, 1, 1)
    JFeries(1) = LPaques
    JFeries(2) = LPaques + 38
    JFeries(3) = LPaques + 49
    JFeries(4) = DateSerial(An, 5, 1)
    JFeries(5) = DateSerial(An, 5, 8)
    JFeries(6) = DateSerial(An, 7, 14)
    JFeries(7) = DateSerial(An, 8, 15)
    JFeries(8) = DateSerial(An, 11, 1)
    JFeries(9) = DateSerial(An, 11, 11)
    JFeries(10) = DateSerial(An, 12, 25)
 
    '   Tri
    For i = LBound(JFeries) 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 Sub
 
 
Sub Tst_Annee()
Dim An As Long, i As Long, j As Long, k As Long
Dim Deb As Date, Fin As Date, bFerie As Boolean
 
    Feuil1.Columns("A:B").Clear
    An = Feuil1.Cells(1, 4)
    JoursFeries (An)
 
    Deb = CDate("1/1/" & An)
    Fin = CDate("31/12/" & An)
    k = 0
    For i = Deb To Fin
        bFerie = False
        For j = 0 To 10
            If JFeries(j) = i Then
                bFerie = True
                Exit For
            End If
        Next j
        If Weekday(i, vbMonday) < 6 And bFerie = False Then
            k = k + 1
            Feuil1.Cells(k, 1) = CDate(i)
        End If
    Next i
End Sub

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
Private Function NbJoursMois(Optional dDate As Date = 0) As Integer
    If dDate = 0 Then dDate = Date
    NbJoursMois = DateSerial(Year(dDate), Month(dDate) + 1, 1) - DateSerial(Year(dDate), Month(dDate), 1)
End Function
 
Sub Tst_Mois()
Dim An As Long, Mois As Long, i As Long, j As Long, k As Long
Dim Deb As Date, Fin As Date, bFerie As Boolean
Dim JoursMois As Long
 
    Feuil1.Columns("A:B").Clear
 
    An = Feuil1.Cells(1, 4)
    Mois = Feuil1.Cells(2, 4)
 
    JoursFeries (An)
    JoursMois = NbJoursMois("1 /" & Mois & "/" & An)
 
    Deb = CDate("1/" & Mois & "/" & An)
    Fin = CDate(JoursMois & "/" & Mois & "/" & An)
    k = 0
    For i = Deb To Fin
        bFerie = False
        For j = 0 To 10
            If JFeries(j) = i Then
                bFerie = True
                Exit For
            End If
        Next j
        If Weekday(i, vbMonday) < 6 And bFerie = False Then
            k = k + 1
            Feuil1.Cells(k, 1) = CDate(i)
        End If
    Next i
End Sub