Obliger à entrer une date selon un format précis
Bonjour :-)))))))))))))))
BsAlv m'a écrit un code qui fonctionne à merveille, notamment pour les "case" de 1 à 10.
J'ai essayé de m'en inspirer pour entrer mes dates d'anniversaire mais j'avoue, plusieurs termes me bloquent.
En réalité j'aimerais avoir un nouveau "case" pour obliger à ne saisir que 8 chiffres.
Exemple : 06101968 et à la validation, que ça m'inscrive dans la cellule sous la forme 06/10/1968.
Avec en "Validation de données", une erreur si les dates ne sont pas comprises entre 1945 et 2015.... :-)))))
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom, LO, Isect As Range, sHeader, i, i1, Temp, bVide
Set LO = Me.Range("tabel1").ListObject
If Target.CountLarge > 1 Then Exit Sub 'arrêter si on change plusieurs cellules en même temps
Set Isect = Intersect(Me.Range("tabel1"), Target) 'juste les cellules modifiées dans le tableau (plus tard dans la macro)
If Target.Address = Me.Range("Filtre_Nom").Address And Len(Target.Value) > 0 Then 'on a modifié le nom dans la cellule jaune et la cellule n'est pas vide
Me.Unprotect MdP
LO.Range.AutoFilter
i = LO.ListColumns("Nom").Index 'position colonne "Nom" **************
Nom = Target.Value
If Application.WorksheetFunction.CountIf(Range("tabel1[nom]"), Nom & "*") > 0 Then 'il existe des "matches" dans la colonne "Nom"
LO.Range.AutoFilter i, Nom & "*" 'utiliser cette position pour le filtre
Application.GoTo LO.DataBodyRange.SpecialCells(xlVisible)(1), 1 'se positionner dans la première cellule visible
Else 'aucun match dans la colonne "nom" = ajouter ce nom dans une nouvelle ligne
With LO
LO.Parent.Unprotect MdP
Application.EnableEvents = False
If .ListRows.Count >= 2 Then 'tableau contient min 2 lignes
.ListRows.Add 2 'ajouter une nouvelle ligne 2
.ListRows(1).Range.Copy .ListRows(2).Range 'copier contenu de la ligne 1 dans ligne 2
On Error Resume Next
With .ListRows(1).Range 'ligne 1 (=état original)
.SpecialCells(xlConstants).ClearContents 'RAZ toutes les cellules sans formules
.Cells(1, i) = UCase(Nom) 'coller le nouveau nom dans ligne 1, aussi colonne "i" !!!!
Application.GoTo .Cells(1, i), 1
End With
End If
Application.EnableEvents = True
Proteger
End With
End If
Proteger
ElseIf Not Isect Is Nothing Then
With Isect 'la cellule mdofiée dans le tableau
i = Isect.Column - LO.Range.Column + 1 'index/position de sa colonne dans le tableau
Set c = LO.HeaderRowRange.Cells(1, i) 'entête correspondant
sHeader = UCase(c.Value2) 'contenu de l'entête
If sHeader Like "E_#*" Then 'entête de sa colonne commence avec "E_" et un chiffre
bVide = (Len(.Value) = 0)
If bVide Then
temp1 = ""
Else
Nouvelle = .Value2
Select Case --Mid(sHeader, 3) 'numéro de l'épreuve= cellule en ligne 4 commence avec "E_" et un chiffre = l'épreuve
'***********************************************************************************************
'ici dépendant de l'épreuve,on choisit un autre "format"
'épreuve 6 = rameur 2000m = mmss00 et sera converti en "[mm]:ss,00"
'épreuve 5 et 7 = rameur 500m et course 200 m = ss00 et sera converti en "[ss],00"
'épreuves 3-10 sauf ces 3, mmss et sera converti en "[mm]:ss"
'***********************************************************************************************
Case 6 'l'épreuves 6 = format "mm:ss,00" >>> rameur 2000 m
b = (1 <= Nouvelle And Nouvelle < 595999) 'valeur entre 1/100 seconde et 1 heure moins 1/100 seconde
If b Then
Temp = Right(WorksheetFunction.Rept("0", 6) & Nouvelle, 6)
temp1 = CDbl(TimeSerial(0, Left(Temp, 2), Mid(Temp, 3, 2)) + Right(Temp, 2) / 86400 / 100)
b = (StrComp(Replace(Replace(WorksheetFunction.Text(temp1, "mm:ss.00"), ".", ""), ":", ""), Temp, 1) = 0) 'convertir valeur en "ss.00"
End If
If Not b Then
MsgBox "valeur douteuse", vbCritical, WorksheetFunction.Text(Nouvelle, "hh:mm:ss.00")
GoTo DEFAIRE 'ignorer modification et reculer vers situation précédente
Else
Nouvelle = temp1
End If
Case 5, 7 'épreuve 5 & 7 = format "ss,00" >>>> rameur 500m et course 200m
b = (1 <= Nouvelle And Nouvelle < 5999) 'valeur entre 0 et 1 minute
If b Then
Temp = Right(WorksheetFunction.Rept("0", 4) & Nouvelle, 4)
temp1 = CDbl(TimeSerial(0, 0, Left(Temp, 2)) + Right(Temp, 2) / 86400 / 100)
b = (StrComp(Replace(WorksheetFunction.Text(temp1, "[ss].00"), ".", ""), Temp, 1) = 0) 'convertir valeur en "ss.00"
End If
If Not b Then
MsgBox "valeur douteuse", vbCritical, WorksheetFunction.Text(Nouvelle, "hh:mm:ss.00")
GoTo DEFAIRE 'ignorer modification et reculer vers situation précédente
Else
Nouvelle = temp1
End If
Case 3 To 10 'épreuves 3 à 10 sauf 5, 6 & 7 = format "mm:ss" = entrer 4 chiffres sans ":" et convertir en "mm:ss"
If 1 <= Nouvelle And Nouvelle < 5959 Then
Temp = Right(WorksheetFunction.Rept("0", 4) & Nouvelle, 4)
temp1 = TimeSerial(0, Left(Temp, 2), Right(Temp, 2))
b = (Minute(temp1) = --Left(Temp, 2)) And ((Second(temp1) = --Right(Temp, 2)))
If Not b Then
MsgBox "valeur douteuse", vbCritical, WorksheetFunction.Text(Nouvelle, "hh:mm:ss.00")
GoTo DEFAIRE 'ignorer modification et reculer vers situation précédente
Else
Nouvelle = CDbl(temp1)
End If
Else
MsgBox "valeur douteuse", vbCritical, WorksheetFunction.Text(Nouvelle, "hh:mm:ss.00")
GoTo DEFAIRE 'ignorer modification et reculer vers situation précédente
End If
Case 1, 2 'les 2 autres épreuves
temp1 = .Value 'rien à modifier ou à controler
End Select
End If
Application.EnableEvents = False
.Value = temp1 'coller la valeur traduite dans la cellule
For j = 4 To 6 'colonne "Date_" se trouve 4-6 colonnes vers droite
b = (LCase(Left(c.Offset(, j).Value2, 5)) Like "date_")
If b Then Exit For
Next
If Not b Then
MsgBox "colonne date introuvable"
Else 'colonne avec "date" trouvée
.Parent.Unprotect MdP
.Offset(, j).Value2 = IIf(bVide, "", CDbl(Now)) 'moment (date&heure) du changement
Proteger
End If
Application.EnableEvents = True ' on remet en marche la surveillance évènementielle
End If
End With
End If
Exit SubJe rappelle que les noms des personnes dans le tableau sont purement inventés donc l'anonymat est entièrement respecté :-)))))))
J'aimerais aussi, svp, que la feuille 2, "concordance...", soit entièrement interdite d'accès sauf pour 3 à 4 personnes dont les désignations se feront pas la suite.
Par exemple, elle n'apparaîtrait que si j'utilise le mot de passe pour ôter la protection de la feuille et ce, à partir de la feuille 1 ou 3 (mdp = seb).
C'est possible ? Ou en tout cas si vous avez d'autres idées, je suis preneur. En fait cette feuille 2 est inutile pour plus de 100 utilisateurs donc sa visibilité est inutile donc pas la peine de stresser les débutants pour qu'ils s'interrogent : "Mais c'est quoi cette feuille, je n'comprends rien !!!". Vous voyez ce que je veux dire ;-)))))))
Merci beaucoup pour votre aide ou en tout cas pour essayer des choses :-)))))))))))))))))))
Bonne journée :-)))))
à bientôt...
BsAlv a résolu mon problème de feuille 2. Désolé je viens tout juste de le découvrir, ça c'est joué à quelques petites minutes près, car je pensais que mon précédent sujet était terminé.
Il faudra juste que j'arrive à associer la résolution du pb de la feuille 2 avec le nouveau fichier Excel que j'ai fourni ce matin ;-)))))
Il me reste mon pb de dates d'anniversaire si le coeur vous en dit ;-))))))))
MErci
à bientôt :-))))))))))))))))))))))))
Bonjour,
je n'ai pas téléchargé votre fichier mais pour empêcher une saisie de date non comprise entre 1945 et 2015, vous sélectionnez la cellule (ici B2), validation des données, autoriser, personnalisé, et comme formule ;
=ET(B2>16437;B2<42370)Bonjour,
Pour la saisie de la date d'anniversaire avec 8 chiffres, attention la colonne est au format texte.
Cdlt
Bonjour Doux rêveur & Arturo83,
Merci bcp ça fonctionne Arturo83 :-)))))))))
Pour la solution de Doux rêveur, j'ai une valeur erronée. Ca vient peut être du format qui est en texte, nan ? Si je mets en nombre ça ne fonctionne pas non plus :-((((
MErci à vous :-)))))))))))))
Bon w.e. :-))))))))
Ah oui, si c'est du texte alors il faut revenir au format nombre, ceci devrait aller pour G5 ;
=ET(DATE(DROITE(G5;4);1;1)>16437;DATE(DROITE(G5;4);1;1)<42370)MErci à toi :-))))))
J'ai bien mis le format en "Nombre" et j'ai essayé plein de dates différentes mais j'ai une erreur à chaque fois et en plus ça me transforme le 10/10/2000 en 36809 ;-))))) Y'a peut-être incompatibilité avec le code vba d'Arturo83 ?
Il ne faut pas toucher à G5, ma formule est à mettre en validation de données pour G5.
Sauf que sur le fichier d'Arturo, la partie validation de données reste grisée.
Et si on tape 8 chiffres, le signe / n'apparaît pas, je pensais que c'était le but de son code.
Le 10/10/2000 correspond bien à 36809, c'est juste une question de format de cellule, il suffit de remettre en date. Sauf qu'avec le code d'Arturo, ça devient du texte si j'ai bien compris (texte auquel est adapté ma formule).
YESSSSSSSSSSSS, c'était bien ça, j'ai remis en format "texte" et ça marche !!! :-))))))
MErci beaucoup.
Me reste plus qu'à voir avec BsAlv pour adapter sa résolution de la feuille 2, à ce nouveau fichier Excel !!!
A bientôt :-)))))))
Bonjour, "Exemple : 06101968 et à la validation, que ça m'inscrive dans la cellule sous la forme 06/10/1968."
Pour mon édification personnelle, quelle est l'utilité pratique de cette forme de saisie des dates ?
Bonsoir Félix,
ça évite d'entrer les "/" ;-)))
Bonjour à tous,
ça évite d'entrer les "/" ;-)))
???
Bah, saisir directement 6/10/68 ça transforme en 06/10/1968 et ça fait un caractère de moins que 06101968 !
Bonjour BeGood,
c'est une façon de voir, c'est certain :-)))))
En tout cas pour moi, c mieux de ne saisir que des chiffres ;-))) PAs grave si y'a un caractère de plus...