Suivi multi-comptes

Bon alors j'ai essayé ce que j'avais compris message d'erreur. J'ai essayer de reprendre votre nouveau fichier de base et de copier le VBA mensualisation mai ca me met pareil :'(

bug12

Car si je reprend le fichier de base je dois tout retaper je suppose :S

Merci à vous, vous venez de soulever un problème ! )

Il vous suffit de rajouter , New_Date As Integer

à la suite d'une ligne qui commence par DIM

Exemple : à la suite de Dim Ecran As Boolean

Je vais de ce pas modifier la version téléchargeable !

En fait non la version téléchargeable est bonne, normalement... C'est que la votre "date" un peu

@ bientôt

LouReeD

ahhh j'arrive pas lol

Option Explicit
Sub La_Mensualisation()
    Dim Ecran As Boolean, New_Date As Integer
    If Application.ScreenUpdating = True Then
        Application.ScreenUpdating = False
        Ecran = True
    End If
    Application.EnableEvents = False
    Dim Ligne_testée As Long, Colonne_du_Mois As Integer, Ligne_écritures As Long, Le_Mois, Cpt As Integer
    Dim WS As Worksheet
    Ligne_écritures = Der_Lig + 1
    Ligne_testée = 2
    Set WS = Sheets("Mensualisation")
    If [Date_Mensualisation].Value > Month(Now) And [Date_Mensualisation].Value < 12 Then
        With WS
            For Le_Mois = [Date_Mensualisation].Value + 1 To 12
                Colonne_du_Mois = 7 + Le_Mois
                Do
                    If .Cells(Ligne_testée, 1).Value = "" Then Exit Do
                    If .Cells(Ligne_testée, Colonne_du_Mois).Value <> "" Then
                        ' mise en place de la mensualisation
                        If .Cells(Ligne_testée, 1).Value < 29 Then
                            New_Date = .Cells(Ligne_testée, 1).Value
                        ElseIf .Cells(Ligne_testée, 1).Value > 28 And Le_Mois = 2 Then
                            New_Date = 28
                        ElseIf .Cells(Ligne_testée, 1).Value > 30 And (Le_Mois = 4 Or Le_Mois = 6 Or Le_Mois = 9 Or Le_Mois = 11) Then
                            New_Date = 30
                        Else
                            New_Date = .Cells(Ligne_testée, 1).Value
                        End If
                        ' la date
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Date").Column).Value = CDate(New_Date & "/" & Le_Mois & "/" & Year(Now) - 1)
                        ' le nom du compte
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Compte").Column).Value = .Cells(Ligne_testée, 2).Value
                        ' libellé principal
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Principal").Column).Value = .Cells(Ligne_testée, 3).Value
                        ' libellé automatique (secondaire)
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Auto").Column).Value = .Cells(Ligne_testée, 4).Value
                        ' libellé libre
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Lib").Column).Value = .Cells(Ligne_testée, 5).Value
                        ' mode de paiement
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Mode").Column).Value = .Cells(Ligne_testée, 6).Value
                        ' crédit ou débit
                        If .Cells(Ligne_testée, 7).Value = "Crédit" Then
                            Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Cr").Column).Value = .Cells(Ligne_testée, Colonne_du_Mois).Value
                        Else
                            Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_De").Column).Value = .Cells(Ligne_testée, Colonne_du_Mois).Value
                        End If
                        Ligne_écritures = Ligne_écritures + 1
                    End If
                    Ligne_testée = Ligne_testée + 1
                Loop
                Ligne_testée = 2
            Next Le_Mois
            For Le_Mois = 1 To Month(Now)
                Colonne_du_Mois = 7 + Le_Mois
                Do
                    If .Cells(Ligne_testée, 1).Value = "" Then Exit Do
                    If .Cells(Ligne_testée, Colonne_du_Mois).Value <> "" Then
                        ' mise en place de la mensualisation
                        If .Cells(Ligne_testée, 1).Value < 29 Then
                            New_Date = .Cells(Ligne_testée, 1).Value
                        ElseIf .Cells(Ligne_testée, 1).Value > 28 And Le_Mois = 2 Then
                            New_Date = 28
                        ElseIf .Cells(Ligne_testée, 1).Value > 30 And (Le_Mois = 4 Or Le_Mois = 6 Or Le_Mois = 9 Or Le_Mois = 11) Then
                            New_Date = 30
                        Else
                            New_Date = .Cells(Ligne_testée, 1).Value
                        End If
                        ' la date
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Date").Column).Value = CDate(New_Date & "/" & Le_Mois & "/" & Year(Now))
                        ' le nom du compte
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Compte").Column).Value = .Cells(Ligne_testée, 2).Value
                        ' libellé principal
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Principal").Column).Value = .Cells(Ligne_testée, 3).Value
                        ' libellé automatique (secondaire)
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Auto").Column).Value = .Cells(Ligne_testée, 4).Value
                        ' libellé libre
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Lib").Column).Value = .Cells(Ligne_testée, 5).Value
                        ' mode de paiement
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Mode").Column).Value = .Cells(Ligne_testée, 6).Value
                        ' crédit ou débit
                        If .Cells(Ligne_testée, 7).Value = "Crédit" Then
                            Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Cr").Column).Value = .Cells(Ligne_testée, Colonne_du_Mois).Value
                        Else
                            Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_De").Column).Value = .Cells(Ligne_testée, Colonne_du_Mois).Value
                        End If
                        Ligne_écritures = Ligne_écritures + 1
                    End If
                    Ligne_testée = Ligne_testée + 1
                Loop
                Ligne_testée = 2
            Next Le_Mois
        End With
    Else
        With WS
            If [Date_Mensualisation].Value = 12 Then [Date_Mensualisation].Value = 0
            For Le_Mois = [Date_Mensualisation].Value + 1 To Month(Now)
                Colonne_du_Mois = 7 + Le_Mois
                Do
                    If .Cells(Ligne_testée, 1).Value = "" Then Exit Do
                    If .Cells(Ligne_testée, Colonne_du_Mois).Value <> "" Then
                        ' mise en place de la mensualisation
                        If .Cells(Ligne_testée, 1).Value < 29 Then
                            New_Date = .Cells(Ligne_testée, 1).Value
                        ElseIf .Cells(Ligne_testée, 1).Value > 28 And Le_Mois = 2 Then
                            New_Date = 28
                        ElseIf .Cells(Ligne_testée, 1).Value > 30 And (Le_Mois = 4 Or Le_Mois = 6 Or Le_Mois = 9 Or Le_Mois = 11) Then
                            New_Date = 30
                        Else
                            New_Date = .Cells(Ligne_testée, 1).Value
                        End If
                        ' la date
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Date").Column).Value = CDate(New_Date & "/" & Le_Mois & "/" & Year(Now))
                        ' le nom du compte
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Compte").Column).Value = .Cells(Ligne_testée, 2).Value
                        ' libellé principal
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Principal").Column).Value = .Cells(Ligne_testée, 3).Value
                        ' libellé automatique (secondaire)
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Auto").Column).Value = .Cells(Ligne_testée, 4).Value
                        ' libellé libre
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Lib_Lib").Column).Value = .Cells(Ligne_testée, 5).Value
                        ' mode de paiement
                        Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Mode").Column).Value = .Cells(Ligne_testée, 6).Value
                        ' crédit ou débit
                        If .Cells(Ligne_testée, 7).Value = "Crédit" Then
                            Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_Cr").Column).Value = .Cells(Ligne_testée, Colonne_du_Mois).Value
                        Else
                            Sheets("Ecritures").Cells(Ligne_écritures, Sheets("Ecritures").Range("_De").Column).Value = .Cells(Ligne_testée, Colonne_du_Mois).Value
                        End If
                        Ligne_écritures = Ligne_écritures + 1
                    End If
                    Ligne_testée = Ligne_testée + 1
                Loop
                Ligne_testée = 2
            Next Le_Mois
        End With
    End If
    [Date_Mensualisation].Value = Month(Now)
    Application.EnableEvents = True
    If Ecran = True Then
        Application.ScreenUpdating = True
    End If
End Sub

j'ai repris le fichier dispo sur la 1e page j'ai copier le code (il me semble si il y a pas eu un soucis au milieu)

et collet a la place du mien

Erreur 13 et cela s'affiche

bug13

Avez vous modifié la "structure" des feuilles ?

@ bientôt

LouReeD

j'ai trouver. >< un truc a la noix lol.

Par contre on est d'accord que ca me marque même les prélèvements du 15 fevrier par exemple?

Quel est donc ce truc "à la noix" ?

Le fonctionnement des lignes ajoutées :

Si le jour de la mensualisation à écrire est inférieur à 29 alors New_Date = ce jour, donc du 1 au 28 pas de soucis

Si le jour de la mensualisation à écrire est supérieur à 28 et que le mois est égal à février alors New_Date = 28

Si le jour de la mensualisation à écrire est supérieur à 30 et que le mois est égal soit à Avril, Juin, Septembre ou Novembre alors New_Date est égal à 30

Sinon Nex_Date est égal à la date à écrire...

Donc pour les dates marquées au 15 du mois, pas de soucis, on ne transformera que les 31, 30 ou 29 seulement s'il y a incompatibilité avec le mois pour lequel on veut inscrire la mensualité.

@ bientôt

LouReeD

J'avais mis un 0 dans une case normal qu'il bug mdr

je me suis mal exprimer. Ce que voulais demander. C'est au moment ou je clique sur actualisé les mensualisation ca me met toutes les dates même celle qui sont pas passé c'est bien cela?

Par exemple aujourd'hui le 4 février. Si je valide le fait qu'il me demande la mensualisation il vas m'écrire dans mon tableau d'écriture même les mensualisation du 15 février.

En effet, si les mensualisations du mois ne sont pas mises, alors il va toutes les mettre !

Même celle de fin de mois. Normal ce sont des dépenses prévues, alors tant qu'à faire autant les mettre comme cela on voit du premier coup d'œil ce qui nous reste...

Mais ceci ne crée pas de difficulté sur le fonctionnement de l'application, car à chaque nouvelle entrée sur la feuille "Ecritures" les date des opérations sont triées. Comme cela la mensualité du 15 restera en bas de page et les opérations avant le 15 seront triées et placées avant.

La mensualisation, pour faire simple, est gérée par mois et non pas par jour...

@ bientôt

LouReeD

Bonjour,

Le problème pour les mises à jour, c'est que si vous avez (comme moi par exemple) la fiche BD qui ne correspond plus a celle d'origine, plusieurs comptes et plus de 800 lignes à chaque compte, enfin bref refaire tout depuis le début, il devient presque impossible d'être efficace.

Voilà pourquoi je ne fait pas les mises à jour en cours d'année et que je suis obligé d'attendre fin décembre pour repartir de Zéro.

@+

Tres bien c etais juste pour etre sur. Mon soucis est reglere tout est impecable merci beaucoup

En fait carousse, votre "erreur" m'amène à dire qu'il me faut faire une modification du code : en effet il me faut prendre en compte le fait que certains peuvent oublier de mettre une date...

CoYaN, pour ce qui est de la mise à jour, si vous connaissez un peu VBA et l'éditeur, vous pouvez faire simplement un Copier de l'ensemble du code du module "Mensualisation" de l'un pour le coller sur l'autre, pour cela il suffit d'ouvrir les deux applications, de faire [Alt]+[F11] pour aller dans l'éditeur VBA.

Une fois le copier / coller effectué, vous pouvez également supprimer le Userform "gestion de compte" et de faire un glisser / déposer du "nouveau" vers votre application.

Comme cela vous aurez la nouvelle version du USF de gestion des comptes comme vous aurez le code qui gère les "dates impossibles"...

@ bientôt

LouReeD

Voici le code modifié à recopier 3 fois... pour le moment, je vais réfléchir à simplifier tout ceci;-) (désolé CoYaN )

If .Cells(Ligne_testée, 1).Value = "" Or .Cells(Ligne_testée, 1).Value = 0 Then ' si vide ou 0 alors = 1
    New_Date = 1
ElseIf .Cells(Ligne_testée, 1).Value < 29 Then
    New_Date = .Cells(Ligne_testée, 1).Value
ElseIf .Cells(Ligne_testée, 1).Value > 28 And Le_Mois = 2 Then
    New_Date = 28
ElseIf .Cells(Ligne_testée, 1).Value > 30 And (Le_Mois = 4 Or Le_Mois = 6 Or Le_Mois = 9 Or Le_Mois = 11) Then
    New_Date = 30
Else
    New_Date = .Cells(Ligne_testée, 1).Value
End If

@ bientôt

LouReeD

Bonsoir LouReeD,

J'ai téléchargé hier soir ton application Asticot V_1.2 et je suis très satisfaite de disposer de cet outil gratuit. Un GRAND Merci pour ton travail et de l''avoir mis à disposition

Bonne continuation

Elfedelune

Bonsoir elfedelune !

Désolé pour le retard de ma réponse, j'ai lu votre message hier soir, mais je ne peux y répondre que maintenant...

Et c'est bien dommage... Un retour positif sans rien demander en retour, j'avoue que c'est rare

Donc merci beaucoup @ vous pour ce retour, en ce moment je dois vous avouer que cela me remonte mon enthousiasme !

@ bientôt sur le forum

LouReeD

Bonsoir,

n'ayez pas peur d'avoir des "trous" dans vos compte avec ce vert... il totalise à ce jour 14 030 téléchargements !

Merci @ vous !

@ bientôt

LouReeD

Bonjour

merci pour ce programme il m'est très utile.

J'ai juste un petit soucis, lorsque qu'il me demande de mettre à jour en ouvrant le fichier, il me mets une erreur car il ne trouve pas une ancienne version, version qui date de 30.01.2019, mais j'ai déjà enregistrer plusieurs autres versions depuis.

Lors de la fermeture avec le bouton quitter c'est la même chose. Si je ferme normalement avec la croix en haut à droite, pas de soucis.

Comment puis-je corriger ceci?

merci de votre aide

capture

Bonsoir,

le fichier étant autonome je ne comprend pas votre message d'erreur qui cherche un fichier sur le "net".

Avez vous fait des modifications quelconques ?

Comme ça je ne vois pas désolé

@ bientôt

LouReeD

Bonsoir LouReeD,

ajout : à quand la prochaine application TENIA ? mais please, pas de WORM !

dhany

Toujours à l'affut dhany...

Comme un poisson prêt à gober le ver...

Attention tout de même

Une idée sur ce qui se passe ?

@ bientôt

LouReeD

tu a écrit :

Une idée sur ce qui se passe ?

ah non, désolé : j'avais lu le post de bricobois, mais comme toi, j'me demande bien c'qu'il a pu faire pour que ton application autonome recherche un fichier sur le net ! avec de pareilles circonstances, faut vraiment pas s'étonner si y'a des demandes de suivi qui sont complètement indépendantes de ta volonté !

d'un autre côté, la version du 30.01.2019 n'est-elle pas la plus récente ? si oui, pourquoi bricobois parle d'une ancienne version ? bizarre !

dhany

Rechercher des sujets similaires à "suivi multi comptes"