Automatisation écriture comptable

Version imprimable

27/11/2018, 10h11
Ed_Will

1 pièce(s) jointe(s)

Automatisation écriture comptable

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.
27/11/2018, 10h32
Menhir

Citation:

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.
27/11/2018, 10h45
Ed_Will

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,
27/11/2018, 11h15
BENNASR

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
27/11/2018, 11h25
Ed_Will

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
27/11/2018, 11h28
BENNASR

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

Bonjour,

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

Code:

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

27/11/2018, 12h02
Ed_Will

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

1 pièce(s) jointe(s)

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

Code:

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:

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

bonsoir
si vous cherchez à faire un bordure pour chaque pièce comptable vous pouvez modifier le code comme suit :

Code:

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
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
            Sheets("Ecriture").Range("A" & k & ":H" & k + 7).BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic 'Partie ajoutée
             k = k + 9
            j = j + 1
 
    End If
Next i
Sheets("Ecriture").Select
Call MiseEnForme
Application.ScreenUpdating = True
End Sub

27/11/2018, 16h04
Ed_Will

Merci BENNASR, je comprends mieux les modifications proposées au départ, le résultat est au-delà de mes espérances!!! 8-)

Merci, je vais maintenant essayer de me familiariser avec tout ça et y apporter ma touche personnelle si ça n'est pas trop compliqué.