VBA Date cellule ne s'efface pas

[Checko Rosarius]

Bonjour à tous, je suis novice en VBA et je me réfère à vous en espérant une possible solution à mon petit problème de code vba. En fait, j'ai un code pour la gestion de date qui me pose problème lorsque je souhaites effacer la date d'une cellule. Dans la plage A1 à A25 dès que j'inscrit une journée, l'année et le mois s'ajoute automatiquement à la date de jour que j'ai inscris selon la valeur de "E1" Mon problème est qu'il m'est impossible de rendre à nouveau les cellules vide A1 à A25 dont j'ai inscris une valeur par la suite. Je ne souhaite pas simplement supprimer la ligne.

Merci à l'avance de votre aide.

 

[Lone-wolf]

Bonsoir Cheko

Bienvenue sur XLD et bonne année

Si j'ai bien compris, ajoute ceci avant Application.EnableEvents = True

If IsEmpty(Range("E1")) Then Range("A1:A31").ClearContents et augmente la plage à 31, vu que les jours max sont 31.

 

[Lone-wolf]

Re Cheko

J'ai apporté des modifications dans la macro.

Option Explicit
'mois est la plage A2:A31 que j'ai nommée. Onglet Formules > Définir un nom
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Long, dt1 As Range, dt2 As Range

    Application.EnableEvents = False

    Set dt1 = Range("e1")
    Set dt2 = Range("a1")

    dt2 = dt1

    If Not Intersect(Target, [mois]) Is Nothing Then
 
        If IsDate(Target) Then
            d = Day(Target) + 1
        Else
            d = Target
        End If
     
        If IsDate(DateSerial(Year(dt1), Month(dt1), d)) Then
            Target = Year(dt1) & "-" & Month(dt1) & "-" & d
        End If
     
    End If

    If IsEmpty(dt1) Then Range("mois").ClearContents

    Application.EnableEvents = True
End Sub

 

[Checko Rosarius]

Merci Lone-Wolf et bonne année à toi également, En fait, Je ne souhaite pas effacer tous les cellules de la plage A1 : A25 mais seulement ceux sélectionné. Pour le moment, dès que je tente d'effacer une cellule, une date demeure en place avec un 0 à la place de la journée. J'ai également besoin de conserver la valeur en E1

Merci

 

[Lone-wolf]

Re Geko

Même si tu veux effacer les cellules de ton choix, tu est obligé d'éffacer E1, puisque les cellules y font référence.

 

[TooFatBoy]

Bonjour,

Je n'ai pas compris à quoi sert cette macro (qui de plus ne me semble pas 100 % fonctionnelle), et je ne suis pas certain d'avoir bien compris le problème, mais je tente tout de même une réponse en proposant de modifier le test dans ta macro :

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

    If (Not Intersect(Target, Range("A1:A25")) Is Nothing) And (Target <> "") Then
        If IsDate(Target) Then
            d = Day(Target) + 1
        Else
            d = Target
        End If
        If IsDate(DateSerial(Year(Range("E1")), Month(Range("E1")), d)) = True Then
            Target = Year(Range("E1")) & "-" & Month(Range("E1")) & "-" & d
        End If
    End If

    Application.EnableEvents = True

End Sub

 

[Lone-wolf]

Bonjour Marcel et bonne année

Apparemment tu as parfaitement compris le problème . Et avec la ligne (Not Intersect(Target, Range("A1:A25")) Is Nothing) And (Target <> ""), je viens d'apprendre encore quelque chose.

 

[TooFatBoy]

OK. Je vois qu'on a compris le problème de la même façon, et ça me rassure.

Perso j'ai un petit doute sur le fonctionnement de la macro, mais si pour Checko Rosarius elle fonctionne correctement alors c'est parfait.

 

[Lone-wolf]

Bonjour Marcel

Je viens de faire un test en effaçant certaines cellules, ça à l'aire de jouer. Après, si il décide de mettre du texte dans les cellules vides, va falloir gerer les erreurs.

EDIT: en incluant Application.DisplayAlerts = False: d = Target, on peut mettre du texte.

If IsDate(Target) Then
  d = Day(Target) + 1
  Else
  Application.DisplayAlerts = False: d = Target
  End If

 

[Checko Rosarius]

Je vous remercie à tous,, j'ai maintenant ce qu'il me faut et tous fonctionne impeccablement.. Voici le code utiliser...

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
If Not Intersect(Target, Range("A1:A25")) Is Nothing Then
If Target <> "" Or Not IsNumeric(Target) Then

If IsDate(Target) Then
d = Day(Target) + 1
Else
d = Target
End If
If IsDate(DateSerial(Year(Range("E1")), Month(Range("E1")), d)) = True Then
Target = Year(Range("E1")) & "-" & Month(Range("E1")) & "-" & d
End If
'End If

End If
End If
Application.EnableEvents = True
End Sub

Encore une fois, merci de votre temps

 

[TooFatBoy]

tout fonctionne impeccablement. Voici le code utilisé...

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    If Not Intersect(Target, Range("A1:A25")) Is Nothing Then
        If Target <> "" Or Not IsNumeric(Target) Then
       
            If IsDate(Target) Then
                d = Day(Target) + 1
            Else
                d = Target
            End If
            If IsDate(DateSerial(Year(Range("E1")), Month(Range("E1")), d)) = True Then
                Target = Year(Range("E1")) & "-" & Month(Range("E1")) & "-" & d
            End If
            'End If
           
        End If
    End If
    Application.EnableEvents = True
End Sub

Je pense que ta condition Target <> "" Or Not IsNumeric(Target) est erronée ou du moins peut être simplifiée.
En effet, quoi que tu saisisses, si c'est différent de "" alors, que ce soit numérique ou pas, la condition est réalisée. Tu peux donc simplifier en remplaçant par Target <> "", ce qui qu'on retombe exactement sur la macro que j'ai donnée plus haut.

 

[Checko Rosarius]

Oui effectivement, cela fonctionne également merci.. J'ai encore un petit problème, j'ai inclus la commande ci-haut suggéré Application.DisplayAlerts = False: d = Target Mais j'ai tous de même un bogue lorsque j'inscris du texte dans la plage cible.

 

[TooFatBoy]

Essaye d'ajouter And IsNumeric(Target) dans la condition de la macro que j'ai donnée :
If (Not Intersect(Target, Range("A1:A25")) Is Nothing) And (Target <> "") And IsNumeric(Target) Then

Ou alors, dans la dernière macro que tu as donnée, remplace
If Target <> "" Or Not IsNumeric(Target)
par
If Target <> "" And IsNumeric(Target)

 

[Lone-wolf]

Re Marcel, Cheko

Je me disait bien qu'il y avait de la Rhumba dans l'air .... ouuuupps!! Pardon , du texte dans l'air

 

[Checko Rosarius]

La Rhumba,, Finalement, je n'y arrive plus,,, J'ai essayé plusieurs manip...... complètement bloqué... Je me promets un cours VBA éventuellement..