Automatisation écriture comptable

**Ed_Will** · 27/11/2018, 10h11

Bonjour,

Débutant en VBA (c'est le moins que l'on puisse dire), je souhaite réaliser un fichier me permettant d'automatiser mes écritures comptables à partir du récapitulatif de ma caisse.
En clair, dans le fichier joint, à partir des données de l'onglet récap, chaque ligne de cet onglet donnera une écriture contenant 8 lignes dans l'onglet écritures. Les données de ces huit lignes sont simplement collées depuis l'onglet récap.
Sachant que la colonne "n° pièce" de l'onglet écriture devra incrémenté un nouveau numéro à chaque nouvelle écriture comptable, soit toutes les 9 lignes.
Enfin, dans l'idéal

j'aurai aimé ajouter un contrôle permettant de supprimer les lignes de l'onglet écritures ne contenant rien dans la colonne crédit ni débit.

Pour un débutant cela fait quelques variables qui font que je ne sait par où commencer ni dans quel ordre m'y prendre pour automatiser cela.

Une âme charitable aurait un début d'explication ou un conseil?

Merci d'avance.

**Menhir** · 27/11/2018, 10h32

Envoyé par Ed_Will

Une âme charitable aurait un début d'explication ou un conseil?

Tu peux peut-être commencer par lire les règles du forum :
https://www.developpez.net/forums/d8...s-discussions/
http://club.developpez.com/regles/#LIV-N

Ensuite, tu pourras commencer par là : http://bidou.developpez.com/article/VBA/

Commence par faire un code qui copie les valeurs souhaitées dans l'autre onglet.
Ensuite, tu pourras t'attaquer à la boucle qui enchaine les différentes lignes du premier onglet.
Ensuite tu pourras t'attaquer au problème d'incrémentation des pièces.
... etc ...
Résous une étape et passe ensuite à la suivante.

**Ed_Will** · 27/11/2018, 10h45

Bonjour,

Merci pour les informations. Pour copier-coller les infos je vais me débrouiller rien de trop compliqué pour moi.
Je vais continuer les recherches pour le reste.

Cdlt,

**BENNASR** · 27/11/2018, 11h15

bonjour
Pour commencer est ce que on peut supprimer cette ligne fusionner?? (Ligne 3 ???) je le voie unitile
aussi la date !! je voie que inutile de pré saisir les date
La colonne N je crois que l’écart se calcul entre le chiffre d'affaire avec TVA et la somme des encaissement donc 0 et non pas 314 non
Vous optez pour l'enregistrement de toutes les pièces comptables ou bien juste une feuille réservée à l'impression d'une seule opération selon le choix

**Ed_Will** · 27/11/2018, 11h25

Bonjour,

Oui, la ligne 3 était pour me repérer puisque je pensais insérer les mois suivants en dessous, cela me permettait donc de différencier chaque période.
Je pensais également renommer la plage A4:N34 en "Octobre" pour l'utiliser lorsque je réaliserai la boucle qui doit copier-coller les données de tout le mois en même temps.
Idem pour les dates, elles me permettent de visualiser mon chiffre d'affaires pour une date donnée (les 3 premières lignes seront figées pour consulter les mois suivants), de les reporter ensuite dans l'onglet Ecriture pour la transformation des données consultées en écriture comptable.

J'espère ne pas avoir répondu a coté.

Cdlt

**BENNASR** · 27/11/2018, 11h28

re-bonjour
1/Coté conception je préfère supprimer cette ligne et ajouter une colonne pour le mois et une colonne pour l'année extraite directement de la date
2/La colonne N je crois que l’écart se calcul entre le chiffre d'affaire avec TVA et la somme des encaissement donc 0 et non pas 314 non
3/Vous optez pour l'enregistrement de toutes les pièces comptables ou bien juste une feuille réservée à l'impression d'une seule opération selon le choix

**Mr Poulpe** · 27/11/2018, 11h30

Bonjour,

Peut-être que le code de Poulpe suivant peut aider :

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
Option Explicit
Sub EcrituresComptables()
    Dim shtRecap As Worksheet
    Dim shtEcriture As Worksheet
 
    Dim lngrecapFirstRow As Long 'Ligne dans la feuille récap
    Dim lngRecapLastrow As Long 'Dernière ligne du tableau de la feuille récap
    Dim lngEcritureRow As Long 'Ligne dans la feuille écriture
    Dim i As Long 'Itérateur de boucle
    Dim j As Integer
 
    Dim lngPieceCounter As Long 'Compteur de pièce
 
    Const strJOURNAL = "CA"
    Const strNPIECEPREFIX = "CA"
    Const lngBASEPIECENUMBER = 1001
 
    Const intRECAP_DATE_COLUMN = 1
    Const intRECAP_CA0_COLUMN = 2
    Const intRECAP_CA10_COLUMN = 3
    Const intRECAP_CA20_COLUMN = 4
    Const intRECAP_VAT10_COLUMN = 5
    Const intRECAP_VAT20_COLUMN = 6
    Const intCB_COLUMN = 11
    Const intESP_COLUMN = 12
    Const intCHQ_COLUMN = 13
 
    Const intECRITURE_DATE_COLUMN = 1
    Const intECRITURE_JOURNAL_COLUMN = 2
    Const intECRITURE_PIECENUMBER_COLUMN = 3
    Const intECRITURE_ACCOUNTNUMBER_COLUMN = 4
    'Const intECRITURE_COMMENT_COLUMN = 5
    'Const intECRITURE_LABEL_ENTRY = 6
    Const intECRITURE_CREDITAMOUNT_COLUMN = 7
    Const intECRITURE_DEBITAMOUNT_COLUMN = 8
 
    Const strPROVIDER_ACC_CB = "411CB"
    Const strPROVIDER_ACC_ESP = "411ESP"
    Const strPROVIDER_ACC_CHQ = "411CHQ"
 
    Const strSALES_ACC_VAT10 = "707100"
    Const strSALES_ACC_VAT20 = "707200"
    Const strSALES_ACC_VAT0 = "707300"
    Const strVAT10_ACC = "445710"
    Const strVAT20_ACC = "445720"
 
    Set shtRecap = ThisWorkbook.Sheets("Recap")
    Set shtEcriture = ThisWorkbook.Sheets("Ecriture")
 
    lngrecapFirstRow = 4
    lngRecapLastrow = shtRecap.Range("A100000").End(xlUp).Offset(-1, 0).Row
 
    lngPieceCounter = lngBASEPIECENUMBER
    lngEcritureRow = 2
 
    Application.Calculation = xlCalculationManual
    For i = lngrecapFirstRow To lngRecapLastrow
        For j = 0 To 7
            shtEcriture.Cells(lngEcritureRow + j, intECRITURE_DATE_COLUMN) = shtRecap.Cells(i, intRECAP_DATE_COLUMN)
            shtEcriture.Cells(lngEcritureRow + j, intECRITURE_JOURNAL_COLUMN) = strJOURNAL
            shtEcriture.Cells(lngEcritureRow + j, intECRITURE_PIECENUMBER_COLUMN) = strNPIECEPREFIX & Right("0000" & lngPieceCounter, 5)
        Next j
        lngPieceCounter = lngPieceCounter + 1
 
        shtEcriture.Cells(lngEcritureRow + 0, intECRITURE_ACCOUNTNUMBER_COLUMN) = strPROVIDER_ACC_CB
        shtEcriture.Cells(lngEcritureRow + 0, intECRITURE_DEBITAMOUNT_COLUMN) = shtRecap.Cells(i, intCB_COLUMN)
 
        shtEcriture.Cells(lngEcritureRow + 1, intECRITURE_ACCOUNTNUMBER_COLUMN) = strPROVIDER_ACC_ESP
        shtEcriture.Cells(lngEcritureRow + 1, intECRITURE_DEBITAMOUNT_COLUMN) = shtRecap.Cells(i, intESP_COLUMN)
 
        shtEcriture.Cells(lngEcritureRow + 2, intECRITURE_ACCOUNTNUMBER_COLUMN) = strPROVIDER_ACC_CHQ
        shtEcriture.Cells(lngEcritureRow + 2, intECRITURE_DEBITAMOUNT_COLUMN) = shtRecap.Cells(i, intCHQ_COLUMN)
 
        shtEcriture.Cells(lngEcritureRow + 3, intECRITURE_ACCOUNTNUMBER_COLUMN) = strSALES_ACC_VAT10
        shtEcriture.Cells(lngEcritureRow + 3, intECRITURE_CREDITAMOUNT_COLUMN) = shtRecap.Cells(i, intRECAP_CA10_COLUMN)
 
        shtEcriture.Cells(lngEcritureRow + 4, intECRITURE_ACCOUNTNUMBER_COLUMN) = strSALES_ACC_VAT20
        shtEcriture.Cells(lngEcritureRow + 4, intECRITURE_CREDITAMOUNT_COLUMN) = shtRecap.Cells(i, intRECAP_CA20_COLUMN)
 
        shtEcriture.Cells(lngEcritureRow + 5, intECRITURE_ACCOUNTNUMBER_COLUMN) = strSALES_ACC_VAT0
        shtEcriture.Cells(lngEcritureRow + 5, intECRITURE_CREDITAMOUNT_COLUMN) = shtRecap.Cells(i, intRECAP_CA0_COLUMN)
 
        shtEcriture.Cells(lngEcritureRow + 6, intECRITURE_ACCOUNTNUMBER_COLUMN) = strVAT10_ACC
        shtEcriture.Cells(lngEcritureRow + 6, intECRITURE_CREDITAMOUNT_COLUMN) = shtRecap.Cells(i, intRECAP_VAT10_COLUMN)
 
        shtEcriture.Cells(lngEcritureRow + 7, intECRITURE_ACCOUNTNUMBER_COLUMN) = strVAT20_ACC
        shtEcriture.Cells(lngEcritureRow + 7, intECRITURE_CREDITAMOUNT_COLUMN) = shtRecap.Cells(i, intRECAP_VAT20_COLUMN)
 
        lngEcritureRow = lngEcritureRow + 8
    Next i
    Application.Calculation = xlCalculationAutomatic
End Sub

Cordialement,

Poulpe

**Ed_Will** · 27/11/2018, 12h02

Re-Bonjour,

Mr Poulpe, on est effectivement tres proche du résultat recherché (merci et bravo!). Je vais regarder tout ça pour bien comprendre les différentes étapes de calcul et essayer d'y apporter de petites modifications au besoin.

Cdlt

**BENNASR** · 27/11/2018, 13h13

Bonsoir
malgré mon post ci haut passée invisible et reste sans réaction de votre part voilà une proposition à tester
BONNE CONTINUATION

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
Sub comptabiliser()
' *****************nétoyer feuille ECRITURE
Application.ScreenUpdating = False
With Sheets("Ecriture")
.Cells.Clear
End With
 
'*******************Nommer les titres des colonnes
 
    Sheets("Ecriture").Cells(1, 1).Resize(1, 8) = Array("Date", "Journal", "N°Piece", "N° Compte", "Commentaire", "Libellé ecritures", "Crédit", "Débit")
 
 
'********************COMPTABILISER
Dim Tablo
Dim i As Long
Tablo = Sheets("Recap").Range("A3", "P" & Sheets("Recap").Range("P" & Rows.Count).End(xlUp).Row)
k = 2
j = 1
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
    If Tablo(i, 1) <> "" Then
           For h = 2 To 9
            If h = 2 Then Sheets("Ecriture").Range("D" & k) = "411CB": Sheets("Ecriture").Range("H" & k) = Tablo(i, 11): Sheets("Ecriture").Range("A" & k) = Tablo(i, 1): Sheets("Ecriture").Range("B" & k) = "CA": Sheets("Ecriture").Range("C" & k) = j
            If h = 3 Then Sheets("Ecriture").Range("D" & k + 1) = "411ESP": Sheets("Ecriture").Range("H" & k + 1) = Tablo(i, 12): Sheets("Ecriture").Range("A" & k + 1) = Tablo(i, 1): Sheets("Ecriture").Range("B" & k + 1) = "CA": Sheets("Ecriture").Range("C" & k + 1) = j
            If h = 4 Then Sheets("Ecriture").Range("D" & k + 2) = "411CHQ": Sheets("Ecriture").Range("H" & k + 2) = Tablo(i, 13): Sheets("Ecriture").Range("A" & k + 2) = Tablo(i, 1): Sheets("Ecriture").Range("B" & k + 2) = "CA": Sheets("Ecriture").Range("C" & k + 2) = j
            If h = 5 Then Sheets("Ecriture").Range("D" & k + 3) = "707100": Sheets("Ecriture").Range("G" & k + 3) = Tablo(i, 3): Sheets("Ecriture").Range("A" & k + 3) = Tablo(i, 1): Sheets("Ecriture").Range("B" & k + 3) = "CA": Sheets("Ecriture").Range("C" & k + 3) = j
            If h = 6 Then Sheets("Ecriture").Range("D" & k + 4) = "707200": Sheets("Ecriture").Range("G" & k + 4) = Tablo(i, 4): Sheets("Ecriture").Range("A" & k + 4) = Tablo(i, 1): Sheets("Ecriture").Range("B" & k + 4) = "CA": Sheets("Ecriture").Range("C" & k + 4) = j
            If h = 7 Then Sheets("Ecriture").Range("D" & k + 5) = "707300": Sheets("Ecriture").Range("G" & k + 5) = Tablo(i, 2): Sheets("Ecriture").Range("A" & k + 5) = Tablo(i, 1): Sheets("Ecriture").Range("B" & k + 5) = "CA": Sheets("Ecriture").Range("C" & k + 5) = j
            If h = 8 Then Sheets("Ecriture").Range("D" & k + 6) = "445710": Sheets("Ecriture").Range("G" & k + 6) = Tablo(i, 5): Sheets("Ecriture").Range("A" & k + 6) = Tablo(i, 1): Sheets("Ecriture").Range("B" & k + 6) = "CA": Sheets("Ecriture").Range("C" & k + 6) = j
            If h = 9 Then Sheets("Ecriture").Range("D" & k + 7) = "445720": Sheets("Ecriture").Range("G" & k + 7) = Tablo(i, 6): Sheets("Ecriture").Range("A" & k + 7) = Tablo(i, 1): Sheets("Ecriture").Range("B" & k + 7) = "CA": Sheets("Ecriture").Range("C" & k + 7) = j
            Next h
            k = k + 9
            j = j + 1
    End If
Next i
Sheets("Ecriture").Select
Call MiseEnForme
Application.ScreenUpdating = True
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
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
Sub MiseEnForme()
'
' MiseEnForme Macro
'
 
'
    Range("A1:H1").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

Automatisation écriture comptable

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager