Saisie des dates sans les slashs

Bonjour,

Voici un fichier excel permettant de calculer des reconstitutions de carrière dans notre convention collective que j'avais élaboré avec votre aide.

J'ai une nouvelle demande, une personne doit en faire un très grand nombre et souhaiterait que quand elle tappe la date en jjmmaaaa et fasse entrée cela se traduise en date jj/mm/aaaa pour les cellules suivantes :

c8, d15,d16,e15,e16,etc,c21

J'ai bien trouvé des discussions sur ce sujet mais je n'ai pas réussi à le faire.

Pouvez-vous m'aider svp?

Vous en remerciant par avance.

WILHELM Frédéric

Bonjour Frédéric38360

Ce genre de sujet a déjà été abordé, mais pause un problème sérieux

Comment être certain que la personne va saisir les nombres correctement et pas JMMAA ou JJMAA ou JMAAAA !?

Bon sinon, voici un début de possibilité avec l'évènement Change dans ThisWorkbook

A+

Bonjour JExceL2fr, cela a marché sur une ou deux date puis ça a fait debogage et c'est tout cassé.

Voici ce que ça donne.

Merci d'avance pour votre aide.

Frédéric

Bonjour,

cela a marché sur une ou deux date puis ça a fait debogage et c'est tout cassé.

Oui logique car une fois le code exécuté la première fois, la cellule modifiée est au format de date et lors de la deuxième exécution du code la valeur Target existante est au format date. Ce qui fait planter le code.

Allez dans le code Private Sub Workbook_SheetChange proposé par JExcel2FR, ajoutez cette ligne juste avant chaque ligne où vous avez l'instruction CONVDATE TARGET

Target.NumberFormat = "General"

Cela remet la cellule concernée au format standard qui permet au code de continuer sans plantage

Cordialement

Edit: j'aurais aussi apporté une ou deux modifications pour éviter les problèmes en cas d'erreur d'entrée de date. Attendons peut-être le retour de Jexcel2Fr qui s'occupe de votre demande

Salut à tous,

Frédéric38360, JExcel2fr, et Dan, il est vrai qu'une saisie de date sans les slashs dans une case prévue pour des dates s'approche de l'impossible, mais Excel détecte toute action dans les cellules, alors je me suis dit que si on crée la saisie ailleurs dans les feuilles (Sans slash) puis on déverse la date saisie avec des slashs cela pourrait être viable.

J'ai donc repris le programme, j'ai rajouté des cases vertes pour la saisie "SANS SLASH" qui se déversent automatiquement dans les cellules prévues à l'origine

Je vous joins le fichier, il est à torturer, les opérations dans les autres cellules non pas été touchées

Bonjour

Bah je trouve cela plus compliqué et de plus vous mettez deux codes Change au lieu d'un seul

En mettant un seul code dans Thisworkbook, le code sera exécuté sur les cellules définie dans les lignes Intersect et pas ailleurs

De mon coté j'attends de voir ce que Frederico va dire.

Crdlt

Hello,

je trouve la demande compliqué et les réponses encore plus pour juste éviter une saisie de slach

Sur un clavier de fixe (un 102 et quelques touches) le slach se trouve sur le pavé numérique, donc, à moins que vous ayez qu'un clavier sans pavé numérique vous avez un nnnnééééééénnnoorrrmmme risque d'erreur de saisie si vous ne séparez pas les jours mois et années (nb : les pavés numériques seuls existent et coûte moins de temps -donc d'argent- que de corriger les erreurs)

11120 c'est quoi ? 11/1/2000 ou 1/11/2000 ou 11/12/2000 moi je vois mal comment ça peut s'automatiser.

Une possibilité, saisir avec les 0 non significatif, mais du coup ça rallonge la saisie 011120 et oblige à saisir toujours 6 chiffres et du coup "20" c'est 19"20" ou "20"00

Pour éviter cette erreur il faudrait donc saisir l'année en entier en plus des 0 non significatifs : 01112000 (8 caractères) au lieu de saisir 1/11/20 (7 caractères et peu/aucun risque d'erreur)

OK, vous n'aimez pas le slach, saviez vous que vous pouvez aussi utiliser le "-" ? 1-12-20 donne 01/12/2000 et pour différencier 1920 de 2000 il suffirait de saisir l'année en entier

Bref, ça me semble bien des complications et beaucoup de risque d'erreur pour gagner quelques milli secondes

Essayez cet exemple:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge <> 1 Then Exit Sub
 If Intersect(Target, Me.Range("C8,C22,D15:E17")) Is Nothing Then Exit Sub
 If IsDate(Target) Then Exit Sub
 Application.EnableEvents = False
 On Error GoTo mFin
 Dim v As Long
  v = Int(Target.Value2)
  If (VarType(Target.Value2) = vbDouble) And (Left(Target.Text, 1) = "#") Then
    Target.Value = CDate(Format(v, "00/00/0000"))
  Else
    Target.Value = CVErr(xlErrNA)
  End If
mFin:
If Err Then
  Target.Value = CVErr(xlErrNA)
End If
Application.EnableEvents = True
End Sub

bonjour,

je comprends pas le problème , si tu veux des dates au format ddmmyyyy alors pourquoi ne pas formater tes cellules en ddmmyyyy ?

Bonjour,

J'ai rajouté Target.NumberFormat = "General" mais cela ne fonctionne toujours pas.

Je le place mal?

Merci d'avance pour votre aide.

Frédéric

BonjourxlUtilisateur,

J'ai essayé votre code sans succès :

Il y a quelque chose qui ne fonctionne pas.

Bonjour,

J'ai rajouté Target.NumberFormat = "General" mais cela ne fonctionne toujours pas.

Normal que cela ne fonctionne pas car ce n'est pas l'endroit où vous devez placer la ligne comme je vous l'ai écrit ici --> https://forum.excel-pratique.com/s/goto/1270755

---> ajoutez cette ligne juste avant chaque ligne où vous avez l'instruction CONVDATE TARGET

Donc là déplacez la ligne au bon endroit et cela fonctionnera

Après je peux vous donner les améliorations dont je vous ai parlé. Cela complétera l'exécution du code.

J'ai essayé votre code sans succès

Le code doit être placé dans WorkSheet_Change et pas Workbook_SheetChange, chaque feuille a sa propre liste des cellules qui ne sont pas les mème:
Regarde dans le ficher exemple

@xlUtilisateur

Le code doit être placé dans WorkSheet_Change et pas Workbook_SheetChange, chaque feuille a sa propre liste des cellules qui ne sont pas les mème:

Je pense que vous n'avez pas regardé le code proposé par JExcel2FR. Même si les deux feuilles ne sont pas identiques le code prévoit la liste des cellules concernées.
il est donc inutile de dupliquer le code en le plaçant dans les deux feuilles
Pour moi, cela complique et risque d'embrouiller l'utilisateur

Je comprends bien l'idée mais appliquer cette fonction sur toutes les feuilles(concernés ou non) n'est pas tries pertinent et pour chaque changement.

dans mon dernier code j'ai placé la partie commune dans une fonction séparée qui sera appelé selon les adresse de chaque feuille:

Private Sub Worksheet_Change(ByVal Target As Range)

 DateChange Target, Me.Range("C8, C20, D15:E15")

End Sub

Probablement l'idéel c’est d utiliser des ranges nommés qui sont faciles a identifier par la fonction.

Bonjour Dan,

Je ne comprends pas bien votre demande.

J'ai essayé avec ce code :

Cela ne marche pas mieux cela met des dates de la forme 30/10/4670.

Qu'est ce que j'ai mal fait?

Sinon je veux bien des améliorations mais je n'arrive déjà pas à faire fonctionner ce code.

Frédéric

re

Là c'est bon ce que vous avez fait dans la correction du code

Cela ne marche pas mieux cela met des dates de la forme 30/10/4670.

Regarder la vidéo que j'ai faite avec votre fichier

Expliquez ce que vous faites quand vous écrivez que cela ne fonctionne pas afin que je reproduise

Les améliorations, je vous les donnerai après

Edit : voir mon post suivant avec le fichier complet.

moi, je le ferais comme ceci

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
       Dim LigCoef As Long, MaDate(2), C As Range, bBeep

       'part 1 = détecter les 3 plages relevantes pour modifier
       If Not LCase(Sh.Name) Like "reconstitution *" Then Exit Sub       'mauvaise feuille
       Set C = Sh.Range("C8")                'C = plage relevante pour les modifications
       LigCoef = Sh.Cells.Find(What:="Coefficient", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False).Row
       If LigCoef > 0 Then
              Set C = Union(C, Sh.Range("C" & LigCoef + 2))       'ajouter cette cellule àla plage relevante
              If LigCoef >= 19 Then Set C = Union(C, Sh.Range("D15:E" & LigCoef - 3))       'ajouter cette plage
       End If
       If Intersect(Target, C) Is Nothing Then Exit Sub       'target n'est pas une de ces 3 plages

       'part 2 = valider la nouvelle date et si valable, remplacer le contenu de la cellule avec cette nouvelle date
       With Target
              If .CountLarge = 1 Then        'on change une cellele
                     MaDate(0) = Right("00000000" & .Value2, 8)       'ce ne sont pas 6 chiffres
                     If MaDate(0) Like "########" And InStr(1, MaDate(0), "+") + InStr(1, MaDate(0), "-") + InStr(1, MaDate(0), ".") + InStr(1, MaDate(0), ",") = 0 Then
                            MaDate(1) = CLng(CDate(Left(MaDate(0), 2) & "/" & Mid(MaDate(0), 3, 2) & "/" & Right(MaDate(0), 2)))       'la date sous forme "Double"
                            Debug.Print MaDate(0), Format(MaDate(1), "ddmmyyyy")
                            If MaDate(0) = Format(MaDate(1), "ddmmyyyy") Then
                                   If WorksheetFunction.Median(1926, Year(MaDate(1)), 2050) = Year(MaDate(1)) Then 'intervalle années = 1926-2050
                                          bBeep = True
                                          Application.EnableEvents = False       ' Désactiver les évènements
                                          .Value2 = MaDate(1)       'target est la cellule C8
                                          Application.EnableEvents = True       ' Réactiver les évènements
                                   End If
                            End If
                     End If
              End If
       End With
       If Not bBeep Then Beep 'un "Beep" quand on n'a pas su le faire

End Sub

Re

Le fichier complet. Ce sera plus simple

Crdlt

Edit : fichier supprimé. Voir mon post suivant

Bonjour Bsalv, votre fichier fonctionne très bien merci

Frédéric