XL 2019 Macro: Automatisation tableau de trésorerie (données et mois)

SCORP95

XLDnaute Nouveau
Bonjour à tous,

J'ai besoin d'aide sur la création d'une macro pour mon tableau de trésorerie. Vous trouverez ci-joint le fichier avec 5 feuilles:

- "Tableau" recense l'ensemble des encaissements/ décaissements sur 13 mois et selon le type de transactions
- "Saisie ENCAISSEMENT" et "Saisie DECAISSEMENT" permettent d'insérer (grâce au bouton enregistrement) de nouveaux encaissements / décaissements aux tableaux "ListeD" et "ListeE" (voir descrip suivante)
- "Liste encaissements" et "Liste décaissements" qui présentent les tableaux "ListeD" et "ListeE" permettant de faire la liste des nouveaux flux d'encaissements et de décaissements (avec notamment le montant, type de flux et date d'échéance de paiement).

Je ne sais pas si c'est possible mais voici le but: Créer une macro (un bouton) permettant de prendre la valeur de chaque montant d'un nouveau encaissement/décaissement issus du tableau "ListeD" ou "ListeE" et d'insérer cette valeur dans dans la feuille "Tableau" selon la ligne [type de décaissement/encaissement] et la colonne [mois selon la date d'échéance}. Donc au fur et a mesure qu'il y ait de nouveaux flux selon le type et le mois, les valeurs s'additionnent dans les cellules.

Voila un exemple pour être concret:

Dans la feuille "Liste décaissements", le dernier flux est de 2900 euros concernant le type "Loyer-charges KB" et devant être payer en juin 2021 (voir capture 1). J'aimerais insérer le montant de 2900 dans le tableau décaissement de la 1ère feuille (voir capture 2).

Cela fait plusieurs jours que j'essaie toutes sortes de codes sans succès...😞 Si une âme charitable pouvez m'aider sur cela, vous rendriez un homme heureux.

En espérant avoir été clair, je vous remercie d'avance. Belle année 2021 !

Scorp.
 

Pièces jointes

  • tableau flux de decaissement.xlsm
    80.8 KB · Affichages: 50
  • 2.PNG
    2.PNG
    55.1 KB · Affichages: 81
  • 1.PNG
    1.PNG
    78.4 KB · Affichages: 75
Dernière édition:
Solution
Bonjour,

Essayez ceci, un bouton est placé dans les feuilles Liste Encaissements et Décaissements,
Le principe: le programme lit la colonne I "Transféré dans Tableau" de la feuille à traiter, si l'une des cellules ne contient pas 'Oui", alors les données sont reportées dans le Tableau" Après exécution, la colonne i est remplie de "Oui", interdisant toutes nouvelles prises en compte des valeurs .

Le code:
VB:
Sub Recopier_Liste_Decaissements()
    Dim f1 As Worksheet, f5 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f5 As Long, i As Long
    Dim Type_Dec As String, Montant_Dec As Double, Ech_Dec As String
    Dim F As Range, t As Range, d As Range
    
    Application.ScreenUpdating = False
    Set f1 = Sheets("Tableau")
    Set f5 =...

Rouge

XLDnaute Impliqué
Bonjour,

Essayez ceci, un bouton est placé dans les feuilles Liste Encaissements et Décaissements,
Le principe: le programme lit la colonne I "Transféré dans Tableau" de la feuille à traiter, si l'une des cellules ne contient pas 'Oui", alors les données sont reportées dans le Tableau" Après exécution, la colonne i est remplie de "Oui", interdisant toutes nouvelles prises en compte des valeurs .

Le code:
VB:
Sub Recopier_Liste_Decaissements()
    Dim f1 As Worksheet, f5 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f5 As Long, i As Long
    Dim Type_Dec As String, Montant_Dec As Double, Ech_Dec As String
    Dim F As Range, t As Range, d As Range
    
    Application.ScreenUpdating = False
    Set f1 = Sheets("Tableau")
    Set f5 = Sheets("Liste Décaissements")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f5 = f5.Range("A" & Rows.Count).End(xlUp).Row
    For i = 4 To DerLig_f5
        If f5.Cells(i, "I") <> "Oui" Then
            Type_Dec = f5.Cells(i, "B")
            Montant_Dec = f5.Cells(i, "E")
            Ech_Dec = Format(Month(f5.Cells(i, "F")) & "-" & Year(f5.Cells(i, "F")), "mmm-yy")
            Set F = f1.Cells.Find("FLUX DE DECAISSEMENTS", lookat:=xlWhole)
            If Not F Is Nothing Then
                Set t = f1.Range(f1.Cells(F.Row + 1, "A"), f1.Cells(DerLig_f1, "A")).Find(Type_Dec, lookat:=xlWhole)
                If Not t Is Nothing Then
                    Set d = f1.Range(f1.Cells(F.Row + 1, "A"), f1.Cells(F.Row + 1, "O")).Find(Ech_Dec, lookat:=xlWhole)
                    If Not d Is Nothing Then
                        f1.Cells(t.Row, d.Column) = f1.Cells(t.Row, d.Column) + Montant_Dec
                    End If
                End If
            End If
        End If
        f5.Cells(i, "I") = "Oui"
    Next i
    
    f1.Select
    Set F = Nothing
    Set t = Nothing
    Set d = Nothing
    Set f1 = Nothing
    Set f5 = Nothing
End Sub

Sub Recopier_Liste_Encaissements()
    Dim f1 As Worksheet, f4 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f4 As Long, i As Long
    Dim Type_Enc As String, Montant_Enc As Double, Ech_Enc As String
    Dim F As Range, t As Range, d As Range
    
    Application.ScreenUpdating = False
    Set f1 = Sheets("Tableau")
    Set f4 = Sheets("Liste Encaissements")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f4 = f4.Range("A" & Rows.Count).End(xlUp).Row
    For i = 4 To DerLig_f4
        If f4.Cells(i, "I") <> "Oui" Then
            Type_Enc = f4.Cells(i, "B")
            Montant_Enc = f4.Cells(i, "E")
            Ech_Enc = Format(Month(f4.Cells(i, "F")) & "-" & Year(f4.Cells(i, "F")), "mmm-yy")
            Set F = f1.Cells.Find("FLUX D'ENCAISSEMENTS", lookat:=xlWhole)
            If Not F Is Nothing Then
                Set t = f1.Range(f1.Cells(F.Row + 1, "A"), f1.Cells(DerLig_f1, "A")).Find(Type_Enc, lookat:=xlWhole)
                If Not t Is Nothing Then
                    Set d = f1.Range(f1.Cells(F.Row + 1, "A"), f1.Cells(F.Row + 1, "O")).Find(Ech_Enc, lookat:=xlWhole)
                    If Not d Is Nothing Then
                        f1.Cells(t.Row, d.Column) = f1.Cells(t.Row, d.Column) + Montant_Enc
                    End If
                End If
            End If
        End If
        f4.Cells(i, "I") = "Oui"
    Next i
    
    f1.Select
    Set F = Nothing
    Set t = Nothing
    Set d = Nothing
    Set f1 = Nothing
    Set f4 = Nothing
End Sub

Cdlt
 

Pièces jointes

  • SCORP95_Automatisation tableau de trésorerie données et mois.xlsm
    77.7 KB · Affichages: 31

SCORP95

XLDnaute Nouveau
Bonjour @Rouge,

Comment vous remercier pour ce miracle...
Votre macro marche super bien! Au début, j'ai cru que les "=" présents dans le tableau empêcheraient l'insertion de données mais cela marche bien malgré le égale. C'est juste magnifique.

MERCI.

Ps: Puis-je savoir comment avez-vous fais pour personnaliser le bouton svp?

Scorp.

Thank U GIF by MOODMAN
 
Dernière édition:

SCORP95

XLDnaute Nouveau
Ps: Puis-je savoir comment avez-vous fais pour personnaliser le bouton svp?

Ce n'est pas un bouton, mais une zone de texte à laquelle on applique le format 3DRegarde la pièce jointe 1090533
Merci pour la démo. Du coup, il est possible d'assimiler une zone de texte à une macro pour en faire un bouton 🙄, vous m'avez appris qqch. Encore merci pour votre temps !!

Belle journée à vous.
 

SCORP95

XLDnaute Nouveau
Bonsoir @Rouge ,

je reviens vers vous suite à ce même fichier. Après avoir fait de petites modif' pour adapter le code pour mes besoins, j'ai remarqué qu'il serait pertinent d'ajouter des msgbox pour contrôler que le montant de chaque ligne des feuilles "saisies" soit intégrer au tableau principal avant l'entrée du "oui" en dernière colonne. Ainsi, pour chacune des conditions non respectées ci-dessous, je voudrais mettre en place une msgbox qui indique par exemple "Erreur - Type/Echéance du décaissement non trouvé". Et une après que toutes les lignes ont été intégrer avec succés pour me le confirmer.



VB:
            If Not F Is Nothing Then
                Set t = f1.Range(f1.Cells(F.Row + 1, "A"), f1.Cells(DerLig_f1, "A")).Find(Type_Dec, lookat:=xlWhole)
                If Not t Is Nothing Then
                    Set d = f1.Range(f1.Cells(F.Row + 1, "A"), f1.Cells(F.Row + 1, "Z")).Find(Ech_Dec, lookat:=xlWhole)
                    If Not d Is Nothing Then
                        f1.Cells(t.Row, d.Column) = f1.Cells(t.Row, d.Column) + Montant_Dec
                    End If
                End If
            End If
        End If

Pensez-vous qu'il est possible de le faire sans modifier l'intégralité du code svp?

Merci d'avance.
 

Pièces jointes

  • tableau flux de decaissement.xlsm
    113 KB · Affichages: 11

Rouge

XLDnaute Impliqué
Bonjour,

Vous oublier de préciser, quelle la date à prendre en compte pour le contrôle?
-La date de commande?
-La date de l'échéance de paiement"?
+La date de paiement? (dans cette colonne il n' y a aucune date)

J'ai supposé qu'il s'agissait de la date de l'échéance, partant de là et de ce que vous demandez, un message qui s'afficherait pour chaque discordance entre les 2 feuilles ne serait pas la bonne méthode.
Je vous propose plutôt ceci: on ajoute 2 colonnes en fin de tableau, une qui fait la somme des valeurs par type d'encaissement ou décaissement et par date et l'autre colonne qui rapatrie la valeur trouvée dans le tableau de synthèse avec les mêmes critères. tout ceci par formule. Ensuite une MFC compare les 2 colonnes et met en rouge l'une des valeurs s'il y a discordance.

Par la suite je mettrai tout ça en VBA, mais avant d'aller plus loin, il faut que vous me disiez si cela vous convient.

Cdlt
 

Pièces jointes

  • SCORP95_Automatisation tableau de trésorerie données et mois_2.xlsm
    98.9 KB · Affichages: 8

SCORP95

XLDnaute Nouveau
Bonjour,

Vous oublier de préciser, quelle la date à prendre en compte pour le contrôle?
-La date de commande?
-La date de l'échéance de paiement"?
+La date de paiement? (dans cette colonne il n' y a aucune date)

J'ai supposé qu'il s'agissait de la date de l'échéance, partant de là et de ce que vous demandez, un message qui s'afficherait pour chaque discordance entre les 2 feuilles ne serait pas la bonne méthode.
Je vous propose plutôt ceci: on ajoute 2 colonnes en fin de tableau, une qui fait la somme des valeurs par type d'encaissement ou décaissement et par date et l'autre colonne qui rapatrie la valeur trouvée dans le tableau de synthèse avec les mêmes critères. tout ceci par formule. Ensuite une MFC compare les 2 colonnes et met en rouge l'une des valeurs s'il y a discordance.

Par la suite je mettrai tout ça en VBA, mais avant d'aller plus loin, il faut que vous me disiez si cela vous convient.

Cdlt
Bonjour Rouge,

Je vous remercie de votre retour. En effet, c'est bien la date d'échéance qui faut prendre. Concernant les 2 colonnes, cela me convient totalement. Le but étant vraiment de contrôler que chaque ligne soit prises en compte, cela permettrait de visualiser la source de discordance précisément. J'avais pensé aux msgbox afin de pas trop charger la page et éviter des bugs inutiles.

(PS: la macro insertion sur le fichier que vous m'avez renvoyer ne marche pas, est-ce normal😕 ?)
 

Rouge

XLDnaute Impliqué
Bonjour,

(PS: la macro insertion sur le fichier que vous m'avez renvoyer ne marche pas, est-ce normal😕 ?)
Je vois que vous avez modifié le code que je vous avais fourni et notamment la ligne
Code:
If f5.Cells(i, "I") <> "Oui" And f5.Cells(i, "I") <> "Non" Then
Si cela doit être différent de "Oui" et différent de "Non" alors vous pouvez écrire
Code:
 If f5.Cells(i, "I") "" then

Maintenant pourquoi cela ne marche pas avec votre ligne, et bien tout simplement dans le code " Non "est écrit avec une majuscule alors que dans la validation de donnée il n'y a pas de majuscule, le VBA considère que ce sont 2 termes différents. Pour pallier à cette éventualité, il suffit d'ajouter ceci
CODE=vb]Option compare text[/CODE]
en toute première ligne du module avent la première macro.

Cdlt
 

SCORP95

XLDnaute Nouveau
Bonjour,

(PS: la macro insertion sur le fichier que vous m'avez renvoyer ne marche pas, est-ce normal😕 ?)
Je vois que vous avez modifié le code que je vous avais fourni et notamment la ligne
Code:
If f5.Cells(i, "I") <> "Oui" And f5.Cells(i, "I") <> "Non" Then
Si cela doit être différent de "Oui" et différent de "Non" alors vous pouvez écrire
Code:
 If f5.Cells(i, "I") "" then

Maintenant pourquoi cela ne marche pas avec votre ligne, et bien tout simplement dans le code " Non "est écrit avec une majuscule alors que dans la validation de donnée il n'y a pas de majuscule, le VBA considère que ce sont 2 termes différents. Pour pallier à cette éventualité, il suffit d'ajouter ceci
CODE=vb]Option compare text[/CODE]
en toute première ligne du module avent la première macro.

Cdlt
Re,

J'ai un petit souci en ajoutant la ligne, ce message d'erreur s'affiche. Je comprends pas pourquoi l'insertion ne fonctionne plus avec le fichier que vous m'avez renvoyer (téléchargé depuis ce site) car celui que j'ai sur mon ordi fonctionne bien (le code est similaire sachant que vous avez seulement ajouté les deux colonnes sur la feuille saisie).
1614440476936.png
 

Rouge

XLDnaute Impliqué
ça va, ne cherchez plus, dans le dernier fichier que j'ai retourné, j'avais modifié le format de date des lignes 5 et 13 de la feuille "tableau" pour que cela colle avec les formules des nouvelles colonnes. je vais corriger cela et vous renvoi le fichier
 

Discussions similaires