Suivi multi-comptes
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
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
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 ?
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