Problème Macro. Récupération de l'année dans une cellule

**PC1967** · 25/02/2010, 11h34

Bonjour,

J'ai une macro qui récupère l'année et le mois dans une cellule d'un fichier factures. Jusqu'à aujourd'hui le format de la cellule était aamm (AA pour Année et mm pour Mois). Depuis Janvier 2010, l'année est passée sur 2 caractères au lieu d'1 et donc toutes factures de 2010 ne sont pas importées.
Je n'arrive pas à modifier la macro pour qu'elle me prenne 2010.

Je joins un modèle de mon fichier CAFacture.xls
Merci d'avance de vos réponses.

Voici la macro :

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
Option Explicit

Dim RW              As Range
Dim nolig           As Integer
Dim nocol           As Integer
Dim repclasseur     As String
Dim nomclasseur     As String
Dim MaDate          As String
Dim cle             As Variant
Dim c               As Object
Dim reference       As String
Dim posc            As Long
Dim compt           As Boolean
Dim L_ClasseurOrigine As String
Dim L_ClasseurCA As String
Dim L_RepClasseur   As String
Dim L_ClasseurFactures As String
Dim groupe As String
Dim dossier As String
Dim annee As Integer
Dim mois As Integer
Dim nomcli As String
Dim cmnt As String
Dim montant As Double
Dim L_DecalDebut As Integer
Dim L_MoisDebut As Integer
Dim L_AnneeDebut As Integer
Dim position As Integer
Dim L_Coeff As Integer
Dim L_NbrMois As Integer



Sub ChargeCA()
'Chargement des CA

Application.ScreenUpdating = False
ActiveSheet.Unprotect

'MsgBox ("La version d'excel est " & Application.Version)

L_ClasseurOrigine = ActiveWorkbook.Name

'Sauvegarde du classeur dans le répertoire courrant
'avec la date du jour de génération
MaDate = Format(Date, "mmm yyyy")
nomclasseur = Left(L_ClasseurOrigine, Len(L_ClasseurOrigine) - 4) & " " & MaDate & ".XLS"
ActiveWorkbook.SaveAs Filename:=nomclasseur
L_ClasseurOrigine = nomclasseur


Application.Goto ("extractionCA")
L_ClasseurCA = ActiveCell.Value

Application.Goto ("MoisDebut")
L_MoisDebut = ActiveCell.Value

Application.Goto ("AnneeDebut")
L_AnneeDebut = ActiveCell.Value

Application.Goto ("Coefficient")
L_Coeff = ActiveCell.Value

Application.Goto ("NbrMois")
L_NbrMois = ActiveCell.Value

'Lecture du classeur des CA
Workbooks.Open Filename:=L_ClasseurCA
L_ClasseurCA = ActiveWorkbook.Name
'Windows(L_ClasseurOrigine).Activate
Workbooks(L_ClasseurCA).Activate

    
    'Lecture du classeur des CA
    For Each RW In Worksheets(1).Cells(1, 1).CurrentRegion.Rows
        Workbooks(L_ClasseurCA).Activate
        If RW.Cells(1, 1).Value = "3" Then
            RW.Select
            groupe = RW.Cells(1, 3)
            annee = Val(Mid(RW.Cells(1, 4), 2, 2))
            mois = Val(Mid(RW.Cells(1, 4), 2, 2))
            dossier = RW.Cells(1, 5)
            nomcli = RW.Cells(1, 6)
            cmnt = RW.Cells(1, 7)
            montant = Val(cmnt) / L_Coeff
            
            If (annee = L_AnneeDebut And mois >= L_MoisDebut) Or annee > L_AnneeDebut Then

                'recherche si la ligne dossier exista déjà
                Workbooks(L_ClasseurOrigine).Activate
                Sheets(2).Select
                cle = dossier
                With Worksheets("XXX + ZZZZ").Range("D1:D12000")
                    Set c = .Find(cle)
                    If Not c Is Nothing Then
                        reference = c.Address(ReferenceStyle:=xlR1C1)
                        posc = InStr(reference, "C")
                        nocol = Val(Mid(reference, posc + 1, 5)) + 2
                        nolig = Val(Mid(reference, 2, posc - 2))
                    Else
                    'recherche du groupe et insertion pour création de la ligne dossier
                        With Worksheets("XXX + ZZZZ").Range("A1:A10000")
                            Set c = .Find(groupe)
                            If Not c Is Nothing Then
                                reference = c.Address(ReferenceStyle:=xlR1C1)
                                posc = InStr(reference, "C")
                                nocol = Val(Mid(reference, posc + 1, 5))
                                nolig = Val(Mid(reference, 2, posc - 2))
                                'Cells(nolig + 1, nocol).Select
                                'Selection.EntireRow.Insert
                                
                                    Rows("" & nolig & ":" & nolig & "").Select
                                    Selection.Copy
                                    nolig = nolig + 1
                                    Rows("" & nolig & ":" & nolig & "").Select
                                    Selection.Insert Shift:=xlDown
                                
                                nocol = nocol + 3
                                Cells(nolig, nocol).Value = dossier
                                nocol = nocol + 2
                                Cells(nolig, nocol).Value = nomcli
                            End If
                        End With
                
                    End If
                End With
                
                'Calcul du decalage
                L_DecalDebut = 13 - L_MoisDebut
                If annee - L_AnneeDebut = 0 Then
                            position = mois - L_MoisDebut + 1
                Else
                    If annee - L_AnneeDebut = 1 Then
                        If mois >= L_MoisDebut Then
                            position = mois + L_DecalDebut + 2
                        Else
                            position = mois + L_DecalDebut
                        End If
                    Else
                        If annee - L_AnneeDebut = 2 Then
                            position = mois + L_DecalDebut + 14
                        End If
                    End If
                End If
                If position <= L_NbrMois Or (position >= 14 And position <= (14 + L_NbrMois)) Then
                    Cells(nolig, nocol + position).Value = montant
                End If
        
                Workbooks(L_ClasseurOrigine).Activate
            
            End If
        End If
    Next
    
    Workbooks(L_ClasseurCA).Close
    Workbooks(L_ClasseurOrigine).Activate
    
    Application.ScreenUpdating = True
    Windows(L_ClasseurOrigine).Activate
    
End Sub

**pgz** · 25/02/2010, 12h53

Bonjour.

Pas besoin de tout ce code si j'ai compris la question.
Si la cellule RW.Cells(1, 4) contient un texte au format AAMM, alors

Code :

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

1
2
annee = Val(Mid$(RW.Cells(1, 4), 1, 2))
mois = Val(Mid$(RW.Cells(1, 4), 3, 2))

Ce code avec tous ses .Select, .ActiveCell, ... est à réécrire complètement et facilement, à mon avis.

Cordialement,

PGZ

**PC1967** · 26/02/2010, 11h08

Merci beaucoup pour votre réponse rapide.
Cela fonctionne parfaitement.
Je dois juste rajouter un 0 devant les exercices inferieur à 2010 dans mon fichier CAFactures.xls en utilisant la fonction concatener.

Problème Macro. Récupération de l'année dans une cellule [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager