Code se redéclenche

Bonsoir,

je propose de modifier le code de la façon suivante :

nb_mois = (Year(Date) - Year(.Range("B16"))) * 12 + Month(Date) - Month(.Range("B16"))
    If nb_mois <> 0 Then        'Test date au premier de chaque mois
        .Range("B16") = Date
        If Val(Range("B17")) > 0 Then
            .Range("B17") = .Range("B17") - nb_mois        'Mensualitées restantes
            If Range("B17") <= 0 Then
            .Range("B17") = "Fini"                            'Mensualitées Fini
            End If
        End If
    End If
    Label479.Caption = .Range("B17")

Ainsi le décompte ne s'effectue que si le nb_mois est différent de zéro c'est à dire quand le mois et/ou l'année sont différents.
En même temps j'en profite pour décompter du nombre de mois restants le nombre de mois écoulés. Ainsi si l'on n'ouvre pas le fichier de plusieurs mois (on ne sait jamais), le nombre d'échéances restantes sera toujours juste.

A tester

Cordialement,

Bonjour,
Voila, j'ai regroupé les deux tests sous un seul. Je pense que cela doit fonctionner :

With ws   'Ws = Sheets("Compte")
    nb_mois = (Year(Date) - Year(.Range("B16"))) * 12 + Month(Date) - Month(.Range("B16"))
    'DECALER ET RECOPIER D'UNE COLONNE ET LIGNES LE PREMIER JOUR DE CHAQUE MOIS AUTOMATIQUEMENT
    If nb_mois <> 0 Then 'Test nb de mois écoulés depuis le dernier calcul
        .Range("B24") = Date  'Date changement de colonne mensuel
        With .Cells(18, Month(Date) + 3).Resize(9, 1)
            .Copy .Offset(0, 1)
            .SpecialCells(xlCellTypeConstants, 23).ClearContents
        End With
        Label481.Caption = Format(.Range("B24"), "Dddd dd Mmm yyyy") 'Date MAJ via Label481
    'CALCUL LE NOMBRE DE MENSUALITES RESTANTES
        .Range("B16") = Date
        If Val(Range("B17")) > 0 Then
            .Range("B17") = .Range("B17") - nb_mois 'Mensualitées restantes
            If Range("B17") <= 0 Then
                .Range("B17") = "Fini" 'Fin des mensualitées
            End If
        End If
    End If
    Label479.Caption = .Range("B17")
End With

A tester
--
Cordialement,

Bonjour pilas31,

Merci beaucoup pour ta réponse ainsi que pour le code modifier, c'est très sympa.

En faisant l'essai ce matin je me suis apercu que j'avais omis de mettre un bout de code, erreur de ma part, mauvaise manip lors de la sélection du code, désolé.

Donc le soucis est toujours le mème et pour infos le code ci-dessous fonctionne a part le soucis énoncé au premier post.

Deux actions doivent s'éxécuter automatiquement le premier de chaque mois.

(1) Recopie des quelques lignes et déplacement vers la droite d'une colonne.
(2) Calcul le nombre des mensualitées restantes.

Comment svp faire en sorte que le bout de code ne s'éxécute qu'une seule fois au premier du mois, tout en tenant compte du commentaire de ta réponse.

Merci pour ton aide et encore désolé pour l'erreur commise, je te souhaite une agréable journée.

Cordialement Ray

'### DECALER ET RECOPIER D'UNE COLONNE ET LIGNES LE PREMIER JOUR DE CHAQUE MOIS AUTOMATIQUEMENT
With Ws                                               'Ws = Sheets("Compte")
  If Month(Date) = .Range("B24") Then                'Test de la date
                    .Range("B24") = Date             'Date changement de colonne mensuel
        
        With .Cells(18, Month(Date) + 3).Resize(9, 1)
             .Copy .Offset(0, 1)
             .SpecialCells(xlCellTypeConstants, 23).ClearContents
        End With
   End If
   
 Label481.Caption = Format(.Range("B24"), "Dddd dd Mmm yyyy")   'Date MAJ via Label481
         
'*** CALCUL LE NOMBRE DE MENSUALITES RESTANTES
nb_mois = (Year(Date) - Year(.Range("B16"))) * 12 + Month(Date) - Month(.Range("B16"))
    If nb_mois <> 0 Then                                     'Test date au 01 de chaque mois
        .Range("B16") = Date
        
        If Val(Range("B17")) > 0 Then
              .Range("B17") = .Range("B17") - nb_mois        'Mensualitées restantes
            If Range("B17") <= 0 Then
              .Range("B17") = "Fini"                         'Fin des mensualitées
            End If
        End If
    'End If
    Label479.Caption = .Range("B17")

Salut pilas31

Salut Yoda

Merci a vous deux pour vos réponses, c'est cool

Alors j'ai essayer les deux codes la modif proposer par l'ami Yoda a l'air de fonctionner car lorsque Excel repasse dans "Userform Initialize()" je n'ai plus le code bout de code qui fonctionne, déja ça de gagner.

Pour les remarques
(1) j'ouvre mon fichier au moins deux fois tous les jours.
(2) Effectivement pour les dates en B17 et B24, je suis d'accord avec toi pour ta proposition de simplifier, calculer nb_mois au début et tout regrouper avec le même test.
j'avais séparer pour éviter de me planter lors du code.

Merci pour l'aide apporter, vu l'heure un bon app a vous.

Bonne après midi

Cdlt Ray

Salut pilas31

J'ai fait des essais cette après midi pour simplifier le code, mais je n'arrive pas faire fonctionner le tout, il y a toujours quelque chose qui ne va pas.

je ne vois plus comment procéder, si tu veux bien, svp et que tu a un peu de temps pour me tout regrouper avec le même test.

Quand tu a le temps rien ne presse, je te remercie pour ton aide.

Bonne soirée a toi

Cdlt Ray

Bonsoir Pilas31,

Merci beaucoup pour la modification, j'ai essayer ça a l'air de fonctionner
SAUF que la date de mise a jour ne s'affiche pas dans le Label481

Label481.Caption = Format(.Range("B24"), "Dddd dd Mmm yyyy") 

Et comment svp je peux tester si cela fonctionne
(en supposant que nous sommes aujourd'hui le 01 Avril 2014)
ce n'ai pas un poisson d'avril ihihih
histoire de voir si tous les changements marche bien

Sinon encore merci pour ton aide

je te souhaite une bonne soirée et un très bon W-end

Cordialement Ray