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
| Option Explicit
Public Enum ColSourceNames
Jour = 1
Piece = 2
Libelle_ecriture = 3
Compte = 4
Libelle = 5
Date = 5
Debit = 6
Credit = 7
[_First] = Jour
[_Last] = Credit
End Enum
Public Const FinalFileFullName = "c:\temp\Ecritures_01.txt"
Public Const Sep = ","
Public Sub Traiter()
Dim fso, txtStream
Dim lastrow As Long, i As Long, j As Long
Dim ws As Worksheet
Dim cpt As Long
Dim txtLigne As String
Dim txtCompte As String
'initiation du fichier de sortie
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtStream = fso.CreateTextFile(FinalFileFullName, True)
'écriture de l'entête
txtStream.Write ("###EBPPivotV1")
'lecture des données
' ici on va considérer que les données sont dans un onglet "source"
'on pourrait proposer de charger le fichier et en copier les infos dans cet onglet "source"
Set ws = ThisWorkbook.Worksheets("source")
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
cpt = 1
For i = 1 To lastrow
If IsDate(ws.Cells(i, ColSourceNames.Date)) Then 'si la cellule Ei est une date,
For j = i + 1 To lastrow
If ws.Cells(j, ColSourceNames.Jour).Value <> "" Then 'et si la cellule A(i+1) est non vide
'on calcule la date que l'on met dans la cellule Aj
txtLigne = vbNewLine & cpt & Sep
txtLigne = txtLigne & Format(ws.Cells(j, ColSourceNames.Jour), "00") & Format(Month(ws.Cells(i, ColSourceNames.Date)), "00") & Format(Year(ws.Cells(i, ColSourceNames.Date)), "00") & Sep
txtLigne = txtLigne & "70" & Sep
txtCompte = Trim(ws.Cells(j, ColSourceNames.Compte).Value)
Select Case Left(txtCompte, 3)
Case "401":
txtCompte = "F" & Right(txtCompte, Len(txtCompte) - 3)
Case "411":
txtCompte = "C" & Right(txtCompte, Len(txtCompte) - 3)
End Select
txtLigne = txtLigne & txtCompte & Sep
txtLigne = txtLigne & Sep
txtLigne = txtLigne & """" & ws.Cells(j, ColSourceNames.Libelle).Value & """" & Sep
txtLigne = txtLigne & ws.Cells(j, ColSourceNames.Piece).Value & Sep
If ws.Cells(j, ColSourceNames.Debit).Value <> 0 Then
'débit
txtLigne = txtLigne & Replace(Format(ws.Cells(j, ColSourceNames.Debit).Value, "0.00"), ",", ".") & Sep
txtLigne = txtLigne & "D" & Sep
Else
'crédit
txtLigne = txtLigne & Replace(Format(ws.Cells(j, ColSourceNames.Credit).Value, "0.00"), ",", ".") & Sep
txtLigne = txtLigne & "C" & Sep
End If
txtLigne = txtLigne & Sep
txtStream.Write (txtLigne)
cpt = cpt + 1
Else
If ws.Cells(j, ColSourceNames.Date).Value <> "Report : " Then
Exit For 'si pas de valeur dans la cellule Aj, on sort de la boucle de création de la date actuelle
End If
End If
Next j
i = j 'on actualise l'indice i (on passe directement à la cellule E de la ligne suivant la fin de la zone
End If
Next i
txtStream.Close
Set txtStream = Nothing
Set fso = Nothing
MsgBox "Traitement fini", vbInformation + vbOKOnly
End Sub |
