Convertir une date jjmmaaaa en jj/mm/aaaa

Résolu
Utilisateur anonyme -  
 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

  1. Manugeo
     
    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
  2. Utilisateur anonyme
     
    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
    0
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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
      0
    2. 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
      0
    3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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
      0
    4. 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
      0
  3. Manugeo
     
    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
    0
  4. Utilisateur anonyme
     
    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
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Manugeo
     
    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
    0
  7. Utilisateur anonyme
     
    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
    0
  8. Manugeo
     
    Dans les options régionales de ton poste de travail, tu n'aurais pas un format de date anglo-saxon, par hasard ?

    Manu
    0
  9. Utilisateur anonyme
     
    Re,

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

    Laure
    0
  10. Manugeo
     
    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
    0
  11. Manugeo
     
    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
    0
  12. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    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?
    0
  13. Utilisateur anonyme
     
    Merci ça marche parfaitement !!

    Encore merci pour votre aide !!
    0
  15. Utilisateur anonyme
     
    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 !!
    0

Discussions similaires

date JJ/MM/AA en JJ/MM/AAAA avec Notepad++
fleptche -
fleptche -

3 réponses
MFG pas encore arrivée
kkwtanne -
brucine -

2 réponses
Problème Whatsapp - "La date est incorrecte"
thvzzz -
Razor -

5 réponses
Problème publipostage date de naissance
garbiche22 -
cg13 -

3 réponses
Colis en cours de transport vers votre site de livraison ?
Ninan_5568 -
JulieVdr -

7 réponses