Discussion :

[moi244]

Bonjour à tous,
J'ai un fichier "RéceptionData.xls"contenant des informations plusieurs lignes (des clients) avec plusieurs information sur chaque client sur plusieurs colonnes.
J'ai crée un code qui fai ceci:

1. ouvre un fichier Excel (un modèl bien spécifique)
2. met les information qui se trouvent dans les colonnes et les insère dans ce nouveau fichier pour chauqe cilent (ligne)
3. Enregister le fichier sous le nom qui se trouve dans les colonne A-B-C

c'est dans le deuxième point que j'ai un problème:
D'aboord j'aimerais séparer les période Début et Fin par annéee civile, celà marche pour la période A mais pas les autres périodes.

Je joint les deux fichiers:
Développez.Données.xls : c'est lui à partir duquel je veux exécuter la macro
Copie de w_p_2427360733_1885641457.xls : c'est lui que la macro crée. Dans ce fichier la partie en Jaune marche bien, mais la partie en vert et en orange je ne sais pas comment le faire.Merci.

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
 
Private Sub CommandButton1_Click()
Dim Chemin$, CodeA$, Fichier$, CodeB$, Client$, Produit$, DeveloppezDonnees$
Dim LectureSeuleRecommandée As Variant
 
Dim debut As Date
Dim fin As Date
Dim m As Integer
 
Chemin = "d:\Documents and Settings\Bureau\test1\Developpez\"
For i = UserForm1.TextBox1 To UserForm1.TextBox2
    CodeA = Sheets("1231").Cells(i, 3)
    CodeB = Sheets("1231").Cells(i, 4)
    Client = Sheets("1231").Cells(i, 2)
    Produit = Sheets("1231").Cells(i, 1)
    Vente = Sheets("1231").Cells(i, 6)
    CodeC = Sheets("1231").Cells(i, 9)
 
  '********************Période A***********************
    debut = Sheets("1231").Cells(i, 11)
    fin = Sheets("1231").Cells(i, 12)
    TrueFalse = Sheets("1231").Cells(i, 15)
    pourcentage = Sheets("1231").Cells(i, 18)
    TitulairePoste = Sheets("1231").Cells(i, 19)
    CodeD = Sheets("1231").Cells(i, 16)
    PourcentagePoste = Sheets("1231").Cells(i, 20)
    Base = Sheets("1231").Cells(i, 21)
  '****************************************************
 
  m = Year(fin) - Year(debut) + 1
 
 
Fichier = CodeA & "_" & CodeB & "_" & Client & "_" & Produit & ".xls"
 
 
If Dir(Chemin & CodeA & "_" & CodeB & "_" & Client, 16) = "" Then
MkDir Chemin & CodeA & "_" & CodeB & "_" & Client
 
    Workbooks.Open Filename:="d:\Documents and Settings\Bureau\test1\Developpez\RéceptionData.xls"
 
    ActiveWorkbook.SaveAs Chemin & CodeA & "_" & CodeB & "_" & Client & "\" & Fichier, Password:="", WriteResPassword:="1234", ReadOnlyRecommended:=True
 
    Sheets("Feuil1").Range("f13") = Client
    Sheets("Feuil1").Range("f14") = Produit
    Sheets("Feuil1").Range("f15") = CodeA
    Sheets("Feuil1").Range("f16") = CodeB
    Sheets("Feuil1").Range("f10") = horo
 
 
 
 
            If Year(debut) = Year(fin) Then
            Sheets("Feuil1").Range("c27") = debut
            Sheets("Feuil1").Range("c28") = fin
 
            Else:
            Sheets("Feuil1").Range("c27") = debut
            Sheets("Feuil1").Cells(28, m + 2) = fin
 
 
                For j = 1 To m - 1
                    Cells(28, j + 2) = DateSerial(Year(debut) + j - 1, 12, 31)
 
                    Cells(27, j + 2 + 1) = DateSerial(Year(debut) + j, 1, 1)
                Next j
            End If
 
 
    For n = 3 To m + 2
 
        Sheets("Feuil1").Cells(52, n) = TrueFalse
        Sheets("Feuil1").Cells(53, n) = pourcentage
        Sheets("Feuil1").Cells(54, n) = TitulairePoste
        Sheets("Feuil1").Cells(55, n) = CodeD
        Sheets("Feuil1").Cells(57, n) = PourcentagePoste
 
        Sheets("Feuil1").Cells(70, n) = Base
 
      Next n
 
 
    ActiveWorkbook.Close SaveChanges:=True
 
 
End If
 
Next i
end sub

[mercatog]

Testé sur tes fichiers

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
Private Sub CommandButton1_Click()
Dim D As Integer, F As Integer, LastLig As Integer, Base As Integer
Dim CodeA As String, CodeB As String, Client As String, Produit As String
Dim Chemin As String, Fichier As String
Dim Pourcentage As Double, PourcentagePoste As Double
Dim m As Integer, t As Byte, j As Byte, k As Byte
Dim Debut As Date, Fin As Date
Dim Wbk As Workbook
 
Application.ScreenUpdating = False
Chemin = "D:\Documents and Settings\Bureau\test1\Developpez\"
'Chemin = "C:\Users\user\Desktop\"                'Pour mon test
With Worksheets("1231")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    D = Val(Me.TextBox1.Value)
    F = Application.Min(Val(Me.TextBox2.Value), LastLig)
    If D >= 3 And F >= D Then
        .Range("AR1").Value = Now
        For i = D To F
            CodeA = .Range("C" & i).Value
            CodeB = .Range("D" & i).Value
            Client = .Range("B" & i).Value
            Produit = .Range("A" & i).Value
            Vente = .Range("F" & i).Value
            CodeC = .Range("I" & i).Value
 
            Fichier = CodeA & "_" & CodeB & "_" & Client & "_" & Produit & ".xls"
            If Dir(Chemin & CodeA & "_" & CodeB & "_" & Client, 16) = "" Then
                MkDir Chemin & CodeA & "_" & CodeB & "_" & Client
                Set Wbk = Workbooks.Open(Filename:=Chemin & "RéceptionData.xls")
                With Wbk.Worksheets("Feuil1")
                    .Range("F13").Value = Client
                    .Range("F14").Value = Produit
                    .Range("F15").Value = CodeA
                    .Range("F16").Value = CodeB
                End With
                '********************Périodes***********************
                k = 0
                For j = 11 To 33 Step 11
                    Debut = .Cells(i, j).Value
                    Fin = .Cells(i, j + 1).Value
                    TrueFalse = .Cells(i, j + 4).Value
                    Pourcentage = .Cells(i, j + 7).Value
                    TitulairePoste = .Cells(i, j + 8).Value
                    CodeD = .Cells(i, j + 5).Value
                    PourcentagePoste = .Cells(i, j + 9).Value
                    Base = .Cells(i, j + 10).Value
                    '****************************************************
                    If Debut * Fin <> 0 Then
                        m = DateDiff("yyyy", Debut, Fin)
 
                        With Wbk.Worksheets("Feuil1")
                            For t = 0 To m
                                .Cells(27, t + 3 + k).Value = CDate(Application.Max(Debut, DateSerial(Year(Debut) + t, 1, 1)))
                                .Cells(28, t + 3 + k).Value = CDate(Application.Min(Fin, DateSerial(Year(Debut) + t, 12, 31)))
                                .Cells(52, t + 3 + k).Value = TrueFalse
                                .Cells(53, t + 3 + k).Value = Pourcentage
                                .Cells(54, t + 3 + k).Value = TitulairePoste
                                .Cells(55, t + 3 + k).Value = CodeD
                                .Cells(57, t + 3 + k).Value = PourcentagePoste
                                .Cells(70, t + 3 + k).Value = Base
                            Next t
                        End With
                        k = k + m + 1
                    End If
                Next j
                Application.DisplayAlerts = False
                Wbk.SaveAs Chemin & CodeA & "_" & CodeB & "_" & Client & "\" & Fichier, Password:="", WriteResPassword:="1234", ReadOnlyRecommended:=True
                Application.DisplayAlerts = True
                Wbk.Close
                Set Wbk = Nothing
            End If
        Next i
        .Range("AR2").Value = Now
        .Range("AR3").Value = .Range("AR2").Value - .Range("AR1").Value
    End If
End With
Unload Me
End Sub

[moi244]

Wow, Merci beaucoup!