Question date pour JOB75

chris6999 · 26 Juin 2012

Bonjour

J’ai trouvé sur le FORUM ce vieux fil sur la transformation d’un chiffre en date.
Le code que vous proposez est très intéressant et j’aimerais l’adapter.
J’ai essayé une paire d’heures hier mais sans résultats probants.
C’est pourquoi je fais appel à votre aide aujourd’hui :

-Ce que je voudrais c’est convertir un nombre de 6 (au lieu de 7) ou 8 chiffres
_Le formats de date attendu est de type JJMMAA (bon ça je suis arrivée à le modifier comme une grande)
-Le truc qui me bloque c’est lorsque la valeur de la cellule est différente de ###### ou de ########.
Ce que je souhaiterais dans ce cas c’est donner l’ordre de refuser la valeur saisie avec un msbox d’alerte par exemple.
Par contre comme il n’y a plus d’exit sub il va falloir limiter cette macro aux plages où j’attends une saisie de date (ex colonne 3, 4, 5 et 6).

J’espère que vous pourrez vous pencher sur cette question et m’aider à adapter ce code à mon projet.

Cordialement

Private Sub Worksheet_Change(ByVal Target As Range)
'---Convertit un nombre de 7 ou 8 chiffres en date---
Dim d As Variant
Set Target = Target.Cells(1, 1) 'une seule cellule
d = Target.Value2 'l'idéal serait de connaître la frappe exacte...
If Not (d Like "#######" Or d Like "########") Then Exit Sub
d = Left(Right(d, 6), 2) & "/" & Left(Right(0 & d, 8), 2) & "/" & Right(d, 4) 'mm/dd/yyyy
d = ExecuteExcel4Macro("DATEVALUE(""" & d & """)")
If IsNumeric(d) Then
Target.NumberFormat = "dd/mm/yyyy"
Target = d
Else
Target.NumberFormat = "General"
End If
End Sub

eddy51 · 26 Juin 2012

Re : Question date pour JOB75

Salut,
Ben si la valeur est differente de ####### ou ######## , ben il change pas en date

chris6999 · 27 Juin 2012

Re : Question date pour JOB75

Bonjour à tous

Je remonte le fil

eddy51 · 27 Juin 2012

Re : Question date pour JOB75

chris6999 à dit:
-Ce que je voudrais c’est convertir un nombre de 6 (au lieu de 7) ou 8 chiffres

Dim d As Variant
Set Target = Target.Cells(1, 1) 'une seule cellule
d = Target.Value2 'l'idéal serait de connaître la frappe exacte...
If Not (d Like "#######" Or d Like "########") Then Exit Sub
d = Left(Right(d, 6), 2) & "/" & Left(Right(0 & d, 8), 2) & "/" & Right(d, 4) 'mm/dd/yyyy
d = ExecuteExcel4Macro("DATEVALUE(""" & d & """)")
If IsNumeric(d) Then
Target.NumberFormat = "dd/mm/yyyy"
Target = d
Else
Target.NumberFormat = "General"
End If
End Sub

Tu modifie cela pour plus avoir 6 et pas 7 ou 8

Target.NumberFormat = "dd/mm/yy" tu supprimes 2y pour voir le format que tu veut

pierrejean · 27 Juin 2012

Re : Question date pour JOB75

Bonjour chris6999

A tester:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'---Convertit un nombre en date---
Set Target = Target.Cells(1, 1) 'une seule cellule
If Not IsDate(Target.Value) Then
  MsgBox ("ceci n'est pas une date")
  Exit Sub
Else
  Target.Value = CDate(Target.Value)
  Target.NumberFormat = "dd/mm/yy"
End If
End Sub

chris6999 · 27 Juin 2012

Re : Question date pour JOB75

Bonjour Pierre-Jean

Je viens de tester ta proposition mais cela ne fonctionne pas chez moi.
Le MSGBOX s'affiche systématiquement (quel que soit la valeur saisie et m^me lorsque je fais un suppress dans une cellule vide). La macro ne transforme pas le chiffre en date et ne positionne pas les / attendus.

Cordialement
Merci quand même pour ton aide

job75 · 27 Juin 2012

Re : Question date pour JOB75

Bonjour chris6999, salut eddy51, pierrejean 🙂

Essayez :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'---Convertit un nombre de 6 ou 8 chiffres en date---
Dim t As Variant, d As Variant
If Intersect(Target, [C2:F65536]) Is Nothing Then Exit Sub 'plage à adapter
Set Target = Target.Cells(1, 1) 'une seule cellule
t = Target.Value2
If IsError(t) Then Exit Sub
If t = "" Then Exit Sub
d = Mid(t, 3, 2) & "/" & Left(t, 2) & "/" & Mid(t, 5) 'mm/dd/yy(yy)
d = ExecuteExcel4Macro("DATEVALUE(""" & d & """)")
Application.EnableEvents = False 'désactive les événements
If IsNumeric(d) And (t Like "######" Or t Like "########") Then
  Target.NumberFormat = "ddmmyy" 'le format date qu'on veut
  Target = d
Else
  MsgBox "Entrée refusée !": Application.Undo 'annule l'entrée
End If
Application.EnableEvents = True
End Sub

A+

chris6999 · 27 Juin 2012

Re : Question date pour JOB75

Bonsoir JOB75 et merci pour cette réponse

Cela fonctionne nickel. Un seul bémol toutefois : lorsque le jour ne comporte qu'un chiffre la macro ne reconnaît pas la date (que l'on mette un zéro ou pas).
Ex 05122010

Je n'arrive pas voir pourquoi.
Il faut dire que cette macro est vraiment très complexe et en même temps géniale

Je vais creuser.
Si une personne du FORUM trouve la solution qu'il n'hésite pas à me la faire savoir.
Cordialement
Merci encore à JOB75 d'avoir pris le temps de répondre à ma demande

job75 · 27 Juin 2012

Re : Question date pour JOB75

Re,

Oui, même si l'on entre un 0 en 1er il n'est pas pris en compte (sauf si la cellule est au format Texte).

Il faut ajouter cette ligne :

Code:

If Len(t) = 5 Or Len(t) = 7 Then t = 0 & t

On contrôle donc l'entrée de 5, 6, 7 ou 8 chiffres.

La macro corrigée :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'---Convertit un nombre de 5, 6, 7 ou 8 chiffres en date---
Dim t As Variant, d As Variant
If Intersect(Target, [C2:F65536]) Is Nothing Then Exit Sub 'plage à adapter
Set Target = Target.Cells(1, 1) 'une seule cellule
t = Target.Value2
If IsError(t) Then Exit Sub
If t = "" Then Exit Sub
If Len(t) = 5 Or Len(t) = 7 Then t = "0" & t
d = Mid(t, 3, 2) & "/" & Left(t, 2) & "/" & Mid(t, 5) 'mm/dd/yy(yy)
d = ExecuteExcel4Macro("DATEVALUE(""" & d & """)")
Application.EnableEvents = False 'désactive les événements
If IsNumeric(d) And (t Like "######" Or t Like "########") Then
  Target.NumberFormat = "ddmmyy" 'le format date qu'on veut
  Target = d
Else
  MsgBox "Entrée refusée !": Application.Undo 'annule l'entrée
End If
Application.EnableEvents = True
End Sub

A+

job75 · 28 Juin 2012

Re : Question date pour JOB75

Bonjour le fil, le forum,

2 remarques encore.

1) Le test t Like "######" Or t Like "########" est inutile.

En effet il est toujours vrai quand IsNumeric(d) est vrai, donc utiliser :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'---Convertit un nombre de 5, 6, 7 ou 8 chiffres en date---
Dim t As Variant, d As Variant
If Intersect(Target, [C2:F65536]) Is Nothing Then Exit Sub 'plage à adapter
Set Target = Target.Cells(1, 1) 'une seule cellule
t = Target.Value2
If IsError(t) Then Exit Sub
If t = "" Then Exit Sub
If Len(t) = 5 Or Len(t) = 7 Then t = "0" & t
d = Mid(t, 3, 2) & "/" & Left(t, 2) & "/" & Mid(t, 5) 'mm/dd/yy(yy)
d = ExecuteExcel4Macro("DATEVALUE(""" & d & """)")
Application.EnableEvents = False 'désactive les événements
If IsNumeric(d) Then
  Target.NumberFormat = "ddmmyy" 'le format date qu'on veut
  Target = d
Else
  MsgBox "Entrée refusée !": Application.Undo 'annule l'entrée
End If
Application.EnableEvents = True
End Sub

2) Si l'on entre (ou revalide) de vraies dates (avec slash /), par exemple :

- 07/02/2013 => entrée refusée

- 14/05/2010 => entrée acceptée => résultat 04/03/2012

Excel n'est pas capable de faire la différence entre 14/05/2010 et sa valeur 40312.

On ne peut pas éviter cet inconvénient.

A+

chris6999 · 28 Juin 2012

Re : Question date pour JOB75

Bonjour JOB75

Je viens de tester votre nouvelle proposition c'est vraiment bien.
Par contre votre remarque 2 est effectivement gênante et du coup rend mon projet inexploitable.
Si les utilisateurs ne font pas attention et entrent une date en dur qui se transforme, cela devient dangereux pour la fiabilité des données.
N'existe-t-il pas un moyen d'interdire la saisie de caractères autres que numériques dans cette plage?
Affichage d'un MSGBOX au moment de la frappe par exemple?

En fin j'imagine que si vous m'annoncez que l'anomalie est incontournable c'est que je ne dois pas me faire trop d'illusion.

Merci quand même d'avoir pris du temps.
Cordialement

job75 à dit:
Bonjour le fil, le forum,

2 remarques encore.

1) Le test t Like "######" Or t Like "########" est inutile.

En effet il est toujours vrai quand IsNumeric(d) est vrai, donc utiliser :

Code:

Private Sub Worksheet_Change(ByVal Target As Range) '---Convertit un nombre de 5, 6, 7 ou 8 chiffres en date--- Dim t As Variant, d As Variant If Intersect(Target, [C2:F65536]) Is Nothing Then Exit Sub 'plage à adapter Set Target = Target.Cells(1, 1) 'une seule cellule t = Target.Value2 If IsError(t) Then Exit Sub If t = "" Then Exit Sub If Len(t) = 5 Or Len(t) = 7 Then t = "0" & t d = Mid(t, 3, 2) & "/" & Left(t, 2) & "/" & Mid(t, 5) 'mm/dd/yy(yy) d = ExecuteExcel4Macro("DATEVALUE(""" & d & """)") Application.EnableEvents = False 'désactive les événements If IsNumeric(d) Then Target.NumberFormat = "ddmmyy" 'le format date qu'on veut Target = d Else MsgBox "Entrée refusée !": Application.Undo 'annule l'entrée End If Application.EnableEvents = True End Sub

2) Si l'on entre (ou revalide) de vraies dates (avec slash /), par exemple :

- 07/02/2013 => entrée refusée

- 14/05/2010 => entrée acceptée => résultat 04/03/2012

Excel n'est pas capable de faire la différence entre 14/05/2010 et sa valeur 40312.

On ne peut pas éviter cet inconvénient.

A+

job75 · 28 Juin 2012

Re : Question date pour JOB75

Re,

Il est impossible de contrôler la frappe dans une cellule.

Par contre on peut le faire sur une TextBox dans un UserForm.

Alors toutes les entrées dans la plage devront se faire via cet UserForm.

C'est un autre problème, de nombreux fils le traitent.

A+

chris6999 · 28 Juin 2012

Re : Question date pour JOB75

Re JOB75

Dommage! Je suis vraiement déçue.
Merci encore pour tout
Cordialement

Question date pour JOB75

chris6999

XLDnaute Impliqué

eddy51

XLDnaute Occasionnel

chris6999

XLDnaute Impliqué

eddy51

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

chris6999

XLDnaute Impliqué

job75

XLDnaute Barbatruc

chris6999

XLDnaute Impliqué

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

chris6999

XLDnaute Impliqué

job75

XLDnaute Barbatruc

chris6999

XLDnaute Impliqué

Discussions similaires

Question date pour JOB75

XLDnaute Impliqué

XLDnaute Occasionnel

XLDnaute Impliqué

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency