Probleme avec saisie dans Private Sub Worksheet_ChangeRésolu

Question

Bonjour,

J'ai un souci avec ce ce code, lorsque lorsque je saisi ma valeur ,
il me retourne la première fois une date ( ce que je veux) 
si je tape plusieurs fois une série de 7 ou 8 chiffres pour modifier ma saisie , il me retourne soit une valeur erronée, soit un dépassement de capacité. Est ce quelqu'un pourrait m'aider ?

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False    '** Désactive l'évènement

    If Not Application.Intersect(Range("C50"), Target(1, 1)) Is Nothing Then

        If IsNumeric(Target(1, 1).Value) And Len(Target(1, 1).Text) = 8 Then    '** Si cellule est numérique et a une longeur de 8 caractères
            Jour = CInt(Left(Target(1, 1).Text, 2))     '** Récupérer Jour
            Mois = CInt(Mid(Target(1, 1).Text, 3, 2))   '** Récupérer Mois
            An = CInt(Right(Target(1, 1).Text, 4))      '** Récupérer An

            If IsDate(DateSerial(An, Mois, Jour)) Then  '** Si c'est bien une date du type "JourMois" valide
                Target(1, 1).Value = DateSerial(An, Mois, Jour) '** Modifier la valeur de la cellule
'                Target(1, 1).NumberFormat = "dd/mm/yyyy"        '** modifier le format de la cellule
            End If

        ElseIf IsNumeric(Target(1, 1).Value) And Len(Target(1, 1).Text) = 7 Then    '** Si cellule est numérique et a une longeur de 7 caractères
            Jour = CInt(Left(Target(1, 1).Text, 1))     '** Récupérer Jour
            Jour = "0" & Jour                           '** si valeur Jour < 10 ajout chiffre 0 avant la valeur
            Mois = CInt(Mid(Target(1, 1).Text, 2, 2))   '** Récupérer Mois
            An = CInt(Right(Target(1, 1).Text, 3))      '** Récupérer An

            If IsDate(DateSerial(An, Mois, Jour)) Then  '** Si c'est bien une date du type "JourMois" valide
                Target(1, 1).Value = DateSerial(An, Mois, Jour) '** Modifier la valeur de la cellule
'                Target(1, 1).NumberFormat = "dd/mm/yyyy"        '** modifier le format de la cellule
            End If

        Else
            Target(1, 1).Value = ""
        End If

        If Target(1, 1).Value > Date Then Target(1, 1).Value = Date                 '** Si saisie superieure à date du jour : On met la date du jour
        If Target(1, 1).Value < (Date - 14) Then Target(1, 1).Value (Date - 14)   '** Si saisie inferieure de 14 jours à date du jour : On met la date Date du jour - 14 jours

        D1 Range("C50").Value: D2 Range("C48").Value
        Call NbOuvrés(D1, D2): Range("C51").Value "": Range("C51").Value NbJOuvrés

    End If

    Application.EnableEvents = True '** Réactive l'évènement

End Sub

nastydog · Accepted Answer

La nuit porte conseil . Ce proverbe se vérifie.

Le problème se trouvait dans une macro du classeur ou on effectuait une sélection, une suppression et une remise en forme des cellules de la feuille concernée. 

Ton code est correct et il fonctionne parfaitement.

Merci pour ton aide
Amicalement
Nasty

jordane45 · Answer

Bonjour,

A tout hasard, avez vous essayé de mettre un point d'arrêt dans le code puis de le faire avancer en mode pas à pas pour essayer de déterminter à quel moment se trouve l'erreur ?



Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI

ucfoutu · Answer

Bonjour,
Ton problème me parait devoir se résumer ainsi :
- 1) vérifier que la saisie est une date valide, sinon ==>> message et retour à la cellule
- 2) si date valide :
-- si > date du jour ===>> remplacer par date du jour
-- si < date du jour - 14 jours ===>> remplacer par date du jour - 14 jours
-- faire tes deux autres opérations (tes 2 dernières lignes)

Est-ce bien cela, que tu veux ?
Je te proposerai quelque chose si tu confirmes.

En ce qui concerne la saisie elle-même (le point 1) : ne crois-tu pas qu'il serait plus facile d'obliger à saisir directement selon ton format (dd/mm/yyyy) ? Cela allègerait ton code de manière significative.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Bon.
Je dois aller à la pêche.
Regarde donc (à tout hasard, si j'ai bien vu juste), ce que ferait ce petit exemple, qui contrôle la saisie en A1 :

Private Sub Worksheet_Change(ByVal Target As Range)
  Static titi As Boolean
  Dim toto As Date
  If titi Then titi = Not titi: Exit Sub
    If Not Intersect(Target, Range("A1")) Is Nothing Then
      If Not IsDate(Target.Text) Then
        alerte Target: Exit Sub
      Else
        toto = CDate(Target.Text)
        If Day(toto) <> Val(Target.Text) Then
          alerte Target: Exit Sub
        Else
          Select Case toto
            Case Is > Date
              toto = Date
            Case Is < Date - 14
              toto = Date - 14
          End Select
          titi = Not titi
          Target.NumberFormat = "dd/mm/yyyy"
          Target.Value = DateSerial(Year(toto), Month(toto), Day(toto))
        End If
      End If
   End If
End Sub
Private Sub alerte(qui As Range)
  qui.Activate
  MsgBox "date non valide"
End Sub

Change bien évidemment cette ligne :

If Not Intersect(Target, Range("A1")) Is Nothing Then

par celle qui te convient
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

nastydog · Answer

Bonjour Jordane45,

Merci pour vos suggestions, mais j'ai essayé le pas à pas sans pouvoir déterminer ou se trouve l'erreur.

nastydog · Answer

Salut UCFOUTU.

D'abord , désolé pour le retard. J'ai revu mon code et j'ai trouvé ou se situe le problème.Ce code fait partie d'un classeur assez conséquent et, le problème était du à un verrouillage des cellules de la feuille et, a un mauvais format de la cellule A1.

Donc si cela peut aider je mets mon nouveau code en ligne.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim valeur As Integer

    Déverrouillage
    If Range("A1").NumberFormat = "m/d/yyyy" Then
        Range("A1").NumberFormat = "General"
    End If
    Verrouillage
    
    If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
        If Target.Address = "$A$1" Then
            Application.EnableEvents = False
            Texte = Target.Value
            valeur = Len(Target)
            Call MaMacro(valeur, Texte)
            Application.EnableEvents = True
        End If
    End If
    
End Sub
Private Sub MaMacro(valeur As Integer, Texte As Variant)

    If IsNumeric(Texte) Then
        
        If (valeur = 7) Then
            jour = 0 & CInt(Left(Texte, 1))
            mois = CInt(Mid(Texte, 2, 2))
            an = CInt(Right(Texte, 3))
        ElseIf (valeur = 8) Then
            jour = CInt(Left(Texte, 2))
            mois = CInt(Mid(Texte, 3, 2))
            an = CInt(Right(Texte, 4))
        Else
        End If
       
        Range("A1").Value = Format(CDate(jour & "/" & mois & "/" & an), "dd/mm/yyyy")
    
    Else
        Range("A1").Value = ""
    End If

End Sub

Par contre, je bute maintenant sur le problème de conversion des dates 
américaines/ français. Je m'explique si je saisis dans la cellule A1:

02 01 2013 j'obtiens 01 02 2013 en affichage
12 01 2013 j'obtiens 01 12 2013 en affichage
13 01 2013 j'obtiens 13 01 2013 en affichage

Je cherche une solution, mais ton aide sera la bienvenue.

Amicalement
Nasty

nastydog · Answer

J'ai oublié de signaler que la partie 2 bugue à cause de ce problème de conversion
-- si date valide :
-- si > date du jour ===>> remplacer par date du jour
-- si < date du jour - 14 jours ===>> remplacer par date du jour - 14 jours

Nastydog

ucfoutu · Answer

As-tu essayé mon code ?
Il travaille avec dates françaises et ne convertit donc pas en d'autres formes de dates et ce : que la cellule soit au départ formatée en texte ou formatée en date dd/mm/yyyy 


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

nastydog · Answer

Je l'essaye actuellement et je l'adapte pour le classeur...

nastydog · Answer

Merci UCFOUTU
Une fois adapté pour mon classeur, le code fonctionne super bien.

nastydog · Answer

Cela fonctionne tant que la page est ouverte.
Mais le programme ne fonctionne pas au prochain appel.

Alors si vous avez une idée, je vous mets l' algorithme.
Appel au programme
Chargement des données.
Affichage des données.

A ce moment l'utilisateur doit pouvoir modifier la valeur date de ma cellule
une fois la valeur saisie , le programme calcule la différence en jours ouvrés entre une valeur date du chargement de données et la valeur saisie.
cette différence doit s'afficher instantenement apres avoir saisi la valeur.
 
C'est pour cette raison que j'utilise l'événement Worksheet_Change mais je pense que je fais fausse route.

Vos suggestions seront les bienvenues

ucfoutu · Answer

Je ne parviens pas à voir vraiment clair dans ton mécanisme, tel qu'exposé.
Montre ton vrai code, au besoin commenté.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Probleme avec saisie dans Private Sub Worksheet_Change

12 réponses

Votre réponse

Discussions similaires