Code se redéclenche Fermé

Question

Bonjour a toutes et tous, Forum bonjour

Configuration: Windows 7 / Internet Explorer 9.0

Excel 2007 - VBA

Voila mon petit soucis, le code ci-dessous qui teste le premier de chaque mois fonctionne bien
il se trouve dans Userform Initialize() et le problème que je rencontre est qu'a chaque fois qu'Excel passe par Userform Initialize() où que l'USF est réinitialisé 

Dans la cellule B17 de ma feuil1(Compte) j'ai inscrit 120 correspondant au nombre de mensualitées et donc doit se décompter au premier de chaque mois de -1

ce que je souhaite svp c'est le compteur B17 se décompte qu'une seule et unique fois par mois (au 01) et non pas a chaque fois qu'excel lit le code

Merci a vous pour votre temps ainsi que de votre aide

Bonne journée a tous

Cordialement Ray

'###### USERFORM INITIALISE'*** CALCUL LE NOMBRE DE MENSUALITES RESTANTES (au départ 120)      If Month(Date) <> .Range("B16") Then         'Test date au premier de chaque mois                      .Range("B16") = Date          If Val(Range("B17")) > 0 Then                  .Range("B17") = .Range("B17") - 1        'Mensualitées restantes                            If Range("B17") = 0 Then                .Range("B17") = "Fini"                            'Mensualitées Fini             End If      End If        Label479.Caption = .Range("B17")                  'Ecrit dans le Label479

pilas31 · Answer

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,

Vieuxray · Answer

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")

Vieuxray · Answer

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

Vieuxray · Answer

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

pilas31 · Answer

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,

Vieuxray · Answer

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

Code se redéclenche

6 réponses

Discussions similaires