Convertir une date jjmmaaaa en jj/mm/aaaa

[Résolu/Fermé]
Signaler
-
 Utilisateur anonyme -
Bonjour

Je voudrai sous Excel pouvoir écrire les dates plus rapidement. Je voudrai que lorsque l'on tape 17062010 on obtienne 17/06/2010.
J'ai trouvé la macro suivante dans un autre forum qui avait été faite pour un UserForm. Je n'arrive pas à la modifier afin qu'elle marche pour des valeurs saisies dans des cellules d'un fichier Excel, en colonne I par exemple.

Private Sub TextBox1_Keyup(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Z = (TextBox1.Value)
If Len(Z) = 2 Then TextBox1.Value = Z & "/"
If Len(Z) = 5 Then TextBox1.Value = Z & "/"
If Len(Z) = 10 Then
If IsDate(Z) Then MsgBox "Bravo"
End If
End Sub

Pourriez-vous m'aider s'il vous plaît.

Laure

14 réponses


Bonjour,

Voici un petit bout de code qui devrait répondre à ta question :

Tu déclenche sur l'évènement change de ta TextBox1 :

Dim MaDate as String

MaDate = CStr(TextBox1.value)
If Len(MaDate) < 8 Then Exit Sub

Textbox1.value = DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2))


Attention : ça ne marche que si la date que tu saisis contient 8 caractères (2 pour le jour, 2 pour le mois et 4 pour l'année) !

Manu
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41713 internautes nous ont dit merci ce mois-ci


Bonjour,

Merci pour ton aide

En fait moi je veux saisir des dates dans des cellules sur Excel ; j'ai modifié ton code ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MaDate As String
Dim i As Integer
For i = 2 To 21 Step 1
MaDate = CStr(Range("A" & i).Value)
If Len(MaDate) < 8 Then Exit Sub
Range("A" & i).Value = DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2))
Next i
End Sub

Ça ne marche pas; car si je renter 17062010 en "A2" cette macro me le transforme en 17/06/2010 et passe en mode arrêt sur la cellule "A3" qui est vide...

là je ne sais plus quoi faire


Laure
Messages postés
16525
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
18 octobre 2021
3 231
Bonjour

Private Sub Worksheet_Change(ByVal Target As Range)  
Dim i As Byte  

'délimite la zone d'action  
If Intersect(Target, Range("A2:A21")) Is Nothing Then: Exit Sub  

'désactive les événements  
Application.EnableEvents = False  

'boucle sur la zone  
For i = 2 To 21  
If Len(Range("A" & i)) = 8 Then
Range("A" & i) = DateSerial(Right(Range("A" & i), 4), Left(Right(Range("A" & i), 6), 2), Left(Range("A" & i), 2)) 
end if 
Next i  


Application.EnableEvents = True  
End Sub


explications: 1/woookshhetts_change se déclenche lorsque tu changes la valeur et c'est ce que tu cherches à faire ! (12092010 en 12/09/2010)
enableevents= false désactive tous les événements et résoud ce problème

2/ j'ai réduis la zone d'action: si dans ta feuille tu as un texte ou un nombre de longueur 8 , tu vas planter ou tu auras une transformation en date!

3/ on aurait pu laisser "madate" mais je ne savais pas si madate est à l'origine en chiffres ou texte
remet là si tu sais le type d'origine


nota: valable qu'à partir de l'année 1900
Utilisateur anonyme
Bonjour,

Merci pour ton aide

Je pense bien avoir fait tout comme il faut, mais non rien ne se passe.

Je suppose que c'est à cause des autres codes comme je l'ai expliqué plus bas. Car du coup j'ai ceci :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Byte

'délimite la zone d'action
If Intersect(Target, Range("I2:I21")) Is Nothing Then: Exit Sub

'désactive les événements
Application.EnableEvents = False

'boucle sur la zone
For i = 2 To 21
If Len(Range("I" & i)) < 8 Then Exit Sub
Range("I" & i) = DateSerial(Right(Range("I" & i), 4), Left(Right(Range("I" & i), 6), 2), Left(Range("I" & i), 2))
Next i

Application.EnableEvents = True


If Not Intersect(Target, [R2:R2]) Is Nothing Then
Demande_correction1
End If

If Range("U2").Value = "Oui" Then
Envoi_fichier
Fin
End If

End Sub


Laure
Messages postés
16525
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
18 octobre 2021
3 231
j'avais modifié mon code:

If Len(Range("A" & i)) = 8 Then
Range("A" & i) = DateSerial(Right(Range("A" & i), 4), Left(Right(Range("A" & i), 6), 2), Left(Range("A" & i), 2))
end if

mais je ne comprend la fin à partir de
If Not Intersect(Target, [R2:R2]) Is Nothing Then
Utilisateur anonyme
Re,

Encore merci de m'aider !

Oui j'ajoute ton code ci-dessous au milieu du mien (le reste à partir de
If Not Intersect(Target, [R2:R2]) Is Nothing Then correspond au code déjà présent sur la feuille)

For i = 2 To 21
If Len(Range("A" & i)) = 8 Then
Range("A" & i) = DateSerial(Right(Range("A" & i), 4), Left(Right(Range("A" & i), 6), 2), Left(Range("A" & i), 2))
End If
Next i

Application.EnableEvents = True


mais rien ne se passe quand je tape 17062010 , j'ai tjrs 17062010

Laure

C'est normal, à cause du test If Len(MaDate) < 8 Then Exit Sub qui arrête la procédure si la valeur rencontrée contient moins de 8 caractères (ce qui est le cas de A3 qui est vide...

Il faut modifier ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MaDate As String
Dim i As Integer
For i = 2 To 21 Step 1
MaDate = CStr(Range("A" & i).Value)
If Len(MaDate) < 8 Then Goto Suite
Range("A" & i).Value = DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2))
Suite:
Next i
End Sub

Ainsi, ta boucle ira bien jusqu'à la ligne 21, mais ne formatera l'affichage que pour les cellules ayant au moins 8 caractères.

Manu

Re,

Là j'ai toute cette ligne en jaune lorsque ça passe à "I3" :

Range("I" & i).Value = DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2))

Je rencontre aussi un autre problème, en fait dans mon fichier j'ai déjà des macros qui s'exécutent lorsqu'une valeur change sur ma feuille ; j'ai donc ajouté ton code (comme ci-dessous) mais là même pour "I2" rien ne se passe..

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaDate As String
Dim i As Integer
For i = 2 To 21 Step 1
MaDate = CStr(Range("I" & i).Value)
If Len(MaDate) < 8 Then GoTo Suite
Range("I" & i).Value = DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2))
Suite:
Next i

If Not Intersect(Target, [R2:R2]) Is Nothing Then
Demande_correction1
End If

If Range("U2").Value = "Oui" Then
Envoi_fichier
Fin
End If

End Sub


Laure

Est-ce que la cellule I3 contient bien une date du type prévu (17062010).

Car, pour être clair, la ligne :
Range("I" & i).Value = DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2))
manipule une donnée numérique (17062010) transformée en Texte pour pouvoir être manipulée.
Après manipulation (ajout des / entre jour, Mois et Année), cette donnée type Texte est transformée en date par la fonction DateSerial.

Si le résultat obtenu n'est pas reconnu comme étant une date, alors la fonction DateSerial ne peut s'effectuer, et ton code s'arrête...

Si il y a un risque de trouver des données d'un type différent de celui prévu (17062010), alors tu modifie ainsi :

On Error Resume Next
Range("I" & i).Value = DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2))
On Error Goto 0

Ainsi, en cas d'impossibilité de convertir tes données en Date formatée, la procédure continue son chemin en passant à la suite.

Obs : n'oublie pas la ligne On Error Goto 0 qui annule le traitement d'erreur.

Manu
Re,

Encore merci de m'aider

J'ai rajouté le code suivant au final :

If Range("U2").Value = "Oui" Or Range("U2").Value = "oui" Or Range("U2").Value = "OUI" Then
Envoi_fichier
Fin
End If

Dim MaDate As String
Dim i As Integer
For i = 2 To 21 Step 1
MaDate = CStr(Range("I" & i).Value)
If Len(MaDate) < 8 Then GoTo Suite

On Error Resume Next
Range("I" & i).Value = DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2))
On Error GoTo 0

Suite:
Next i

En ayant pour format des cellules de la colonne I sur ma feuille "texte", quand je tape 17062010 j'obtiens 6/17/2010

Laure

Dans les options régionales de ton poste de travail, tu n'aurais pas un format de date anglo-saxon, par hasard ?

Manu
Re,

Je suis allée vérifier dans option régional j'ai bien Français(France)

Laure

Ben je vois pas trop d'où ça peut venir.
Essaye une conversion date :

Range("I" & i).Value = CDate(DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2)))

Sans garantie...

(Sur mon poste, ça s'affiche correctement, avec ou sans le CDate)

Manu

Sûrement mieux : formater, et non convertir...

Range("I" & i).Value = Format(DateSerial(Right(MaDate, 4), Left(Right(MaDate, 6), 2), Left(MaDate, 2)), "DD/MM/YYYY")

Tiens-moi au courant

Manu
Messages postés
16525
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
18 octobre 2021
3 231
Curieux, je croyais avoir envoyé plusieurs messages mais avec le systemeccm "commentaires-j'ai une solution" c'est un vrai B... et j'ai du mal à suivre la discussion parallèle avec manu-gero; excuses moi manu gero

ci joint une maquette
https://www.cjoint.com/?grp40BsyS8

macro module feuille
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte
On Error GoTo handle
'délimite la zone d'action
If Intersect(Target, Range("I2:I21")) Is Nothing Then: Exit Sub
'boucle sur la zone
For i = 2 To 21
    If Len(Range("I" & i)) = 8 Then
        Application.EnableEvents = False
        Range("I" & i) = DateSerial(Right(Range("I" & i), 4), Mid(Range("I" & i), 3, 2), Left(Range("I" & i), 2))
handle:
        Application.EnableEvents = True
    End If
Next i
End Sub


et dans module 1
Sub sos()
Application.EnableEvents = True
End Sub


macro indispensable pendant les essais (sortie prématuré de cellule)


en relisant le 1° message, Elsielaure, tu asvais marqué "lorsque j'écris une date" pourquoi tu met une boucle alors?

Merci ça marche parfaitement !!

Encore merci pour votre aide !!

Content pour toi. Bonne suite...

Manu
Merci pour ton aide michel_m

En fait ma feuille excel est destinée à être envoyée par email donc je ne pense pas pouvoir utiliser de module pour le code en question car si je ne me trompe pas le module est lié au classeur

En fait je voulais obtenir une date en format jj/mm/aaaa que je saisisse jjmmaaaa ou jj/mm/aaaa.

Pourquoi j'ai mis une boucle ... heuuu .... je ne sais pas .... Fallait pas ?
Sinon le code de Manugeo marche bien

Encore merci à vous deux !!