Mettre des slashs automatiquement dans une date

[Caro L.]

Bonjour à tous !

Je travaille en ce moment sur un fichier de suivi pour un ami et je rencontre une difficulté, je ne sais pas si c'est compliqué (je programme en VBA, mais là je n'arrive pas à trouver de solution).

En fait, mon ami a de nombreuses dates à rentrer dans son fichier et il souhaiterait inscrire seulement les dates sous la forme ddmmaa dans les cases, et qu'en sortant de la case, les slashs se mettent automatiquement pour obtenir dd/mm/aa en sortant de la case.

Par exemple, pour aujourd'hui, il voudrait taper 051112 dans la case et que cela devienne 05/11/12 quand il sort de la case.

Y a-t-il une manière de bloquer le format de la cellule pour que les slashs se mettent automatiquement ? Biensur, je suppose qu'il faudrait bloquer la longueur du contenu à 6 caractères en passant par validation des données.

Si quelqu'un sait m'aider, ce serait super !

Bonne journée !

 

[Renaud75015]

Re : Mettre des slashs automatiquement dans une date

Tu saisis ta date sous la forme jjmmaa dans une chaîne de type string, tu prends les 2 caractères les plus à gauche et tu les transformes en nombre, les deux caractères suivants, même motif, les deux caractères suivants même punition ; et après ce n'est plus que du traitement numérique. Le risque que l'utilisateur saisisse des dates au format exotique du style jmmaa ou jjmaa n'est pas nul. Vaut mieux exiger au niveau de la saisie une contrainte plutôt que d'avoir une bdd pourrie par des saisies exotiques...

 

[Dranreb]

Re : Mettre des slashs automatiquement dans une date

Bonjour.
Moi je mettrais une Target.Value = DateSerial(Right$(Target.value, 2), Mid$(Target.Value, 2, 2), Left$(Target.Value, 2)) dans une Private Sub Worksheet_Change
C'est sans doute un peu plus compliqué, mais c'est l'idée.
Cordialement.

 

[Caro L.]

Re : Mettre des slashs automatiquement dans une date

Merci beaucoup ! Mais je comprends pas ce que ça donne en code de transformer de string vers nombre ? Et pourquoi passer par un format string ? Ca posera pas de problème si la date commence par zéro (ex : 011012). Désolée pour les questions, mais je galère sur ce truc depuis une semaine 🙂

 

[Dranreb]

Re : Mettre des slashs automatiquement dans une date

Oui je viens d'y penser, c'est ce qui m'a poussé à modifier le message.
Ce serait plutôt du genre
Target.Value = DateSerial(Target.Value Mod 100 + 2000, (Target.Value \ 100) Mod 100, Target.value \ 10000)

 

[Caro L.]

Re : Mettre des slashs automatiquement dans une date

Ca parait plus compliqué, non ?

Et si je faisais un truc du genre :

Selection.Format = @ (pour que le zéro initial soit pris en compte s'il y en a un)
Target.Value = DateSerial(Right$(Target.value, 2), Mid$(Target.Value, 2, 2), Left$(Target.Value, 2)) dans une Private Sub Worksheet_Change (comme tu l'as dit tout à l'heure)

Ce serait bon à ton avis ?

Merci beaucoup encore !

 

[Dranreb]

Re : Mettre des slashs automatiquement dans une date

Non. D'abord ça ne sert à rien de modifier le format une fois qu'une valeur est entrée. Et puis si c'est une valeur numérique ma dernière proposition devrait convenir, qu'il y ait un 0 initial ou pas.

 

[Robert]

Re : Mettre des slashs automatiquement dans une date

Bonjnour le fil, bienvenue Caro, bonjour le forum,

La même idée que Bernard mais en beaucoup plus long... J'ai limité l'action à la colonne 1 (A), tu adapteras si besoin :

Private test As Boolean 'déclare la variable test

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim td As String 'déclare la variable td (Texte de la Date)
Dim j As String 'déclare la variable j (Jour)
Dim m As String 'déclare la variable m (Mois)
Dim a As String 'déclare la variable a (Année)

If test = True Then Exit Sub 'si test est vraie, sort de la procédure
If Target.Column <> 1 Then Exit Sub 'si le changement a lieu ailleurs que dans la colonne 1 (=A), sort de la procédure (à adapter)
'permet d'effacer plusieurs cellules sans bug
For Each cel In Target 'boucle sur toutes les cellules de la sélection
    If cel.Value = "" Then Exit Sub 'si la cellule est effacée, sort de la procédure
Next cel 'prochaine cellule de la boucle
test = True 'définit la variable test
td = Format(CStr(Target.Value), "000000") 'définit la variable td
j = Left(td, 2): m = Mid(td, 3, 2): a = Right(td, 2) 'définit les variables j,m et a
Target.Value = CDate(j & "/" & m & "/" & a) 'modifie la cellule éditée
Target.NumberFormat = "dd/mm/yy" 'applique un format à la cellule éditée
test = False 'redéfinit la variable test
End Sub

Ce qui donnerait avec son code optimisé :

Private test As Boolean 'déclare la variable test

Private Sub Worksheet_Change(ByVal Target As Range)
If test = True Then Exit Sub 'si test est vraie, sort de la procédure
If Target.Column <> 1 Then Exit Sub 'si le changement a lieu ailleurs que dans la colonne 1 (=A), sort de la procédure (à adapter)
'permet d'effacer plusieurs cellules sans bug
For Each cel In Target 'boucle sur toutes les cellules de la sélection
    If cel.Value = "" Then Exit Sub 'si la cellule est effacée, sort de la procédure
Next cel 'prochaine cellule de la boucle
test = True 'définit la variable test
Target.Value = DateSerial(Target.Value Mod 100 + 2000, (Target.Value \ 100) Mod 100, Target.Value \ 10000)
test = False 'redéfinit la variable test
End Sub

 

[Dranreb]

Re : Mettre des slashs automatiquement dans une date

Moi j'ai finalement:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim V As Long: V = Target.Value
'Ajouter les tests sur Target.Column etc. Exit Sub
Application.EnableEvents = False
Target.Value = DateSerial(V Mod 100 + 2000, (V \ 100) Mod 100, V \ 10000)
Application.EnableEvents = True
End Sub

À +

 

[Bebere]

Re : Mettre des slashs automatiquement dans une date

bonjour Carol,Renault,Dranreb
teste ce code pour dates dans colonne A,les cellules doivent être au format texte pour 1er caractère 0
sinon il faut adapter le code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 1 Then 'colonne A
     Application.EnableEvents = False
   If Len(Target.Value) = 6 Then
            Target.Value = DateSerial(Right$(Target.Value, 2), Mid$(Target.Value, 3, 2), Left$(Target.Value, 2))
            Target.NumberFormat = "dd/mm/yy"
        End If
Application.EnableEvents =true
    End If
End Sub

fait sous excel2003

edit: avec recommandation de Dranreb
bonjour Robert

 

[Dranreb]

Re : Mettre des slashs automatiquement dans une date

Très important:
N'oubliez pas les Application.EnableEvents = False
sinon votre résultat est inutilement retraité et c'est casse gueule.
À +

 

[Caro L.]

Re : Mettre des slashs automatiquement dans une date

Tout d'abord un grand meci à Robert et Dranreb 🙂

Dans mon cas, je ne pense pas avoir besoin de détailler autant, car il n'y a qu'une dizaine de cases sur le fichier excel dans lesquelles il y a des dates, donc je ne suis peut-être pas obligée d'utiliser la boucle et le test ?

De plus, j'avais essayé la première proposition de Dranreb et ça me donnait quelque chose de bizarre : quand je mettais 051012, ça me mettait 30/08/2039 et il fallait que je reclique sur la case pour passer une deuxième fois par la boucle pour que ça marche. Et en plus, si l'utilisateur cliquait plusieurs fois, la boucle repartait (logique) mais du coup les données étaient perdues.

Donc merci bcp pour le Application.EnableEvents que je ne connaissais pas !

 

[Caro L.]

Re : Mettre des slashs automatiquement dans une date

Ah, et j'en profite comme j'ai affaire à des experts 🙂 Est-ce qu'un de vous 2 sait comment faire varier un élément dans une adresse de fichier quand on crée un lien vers un autre doc excel ? Je m'explique, j'ai rentré cette formule dans mon doc :
=+ 'G:\Data\Accounting\OFFICER CHECK\2012\10 2012\[10 2012.xls]1!$F$57*0.3

Le 1! correspond à un onglet, donc je voudrais tirer ma formule pour pouvoir l'avoir de 1 à 31 (pour tous les jours du mois). J'ai essayé avec concaténer (en écrivant au-dessus les nombres de 1 à 31), mais ça a été un échec !

 

[MJ13]

Re : Mettre des slashs automatiquement dans une date

Bonjour à tous

J'ai retrouvé cela dans mes archives avec la date au format texte et la date au format JJMMAA:

Private Sub Worksheet_Change(ByVal Target As Range)
'MJ
'Dim JMA As Date
On Error GoTo GestErr
'MsgBox ActiveCell.Offset(-1, 0)
an = Format(Right(ActiveCell.Offset(-1, 0), 2), "00")
Mois = Format(Mid(ActiveCell.Offset(-1, 0), 3, 2), "00")
jour = Format(Left(ActiveCell.Offset(-1, 0), 2), "00")
JMA = jour & "/" & Mois & "/" & an
If Mois <= 12 Then ActiveCell.Offset(-1, 1) = CDate(JMA) Else GoTo GestErr
Exit Sub
GestErr:
For i = 1 To 10: Beep: Next: MsgBox " veuillez entrer une date valide (jjmm)": ActiveCell.Offset(-1, 0).Select: End
End Sub

 

[Modeste geedee]

Re : Mettre des slashs automatiquement dans une date

Bonsour®
😎 pourquoi ne pas utiliser un DTPicker avec ou sans OCX
de nombreux exemples ont été fournis ici (faire une recherche avec ce mot)