XL 2016 Combobox Saisie Date

aurelio.ewane

XLDnaute Occasionnel
Bonjour a tous et merci pour tous ce que vous faites pour nous.
Mon problème est le suivant j'ai une série de Combobox sur lesquels je voudrais créer une fonction qui permettra de saisir une Date.

je voudrais que lors de la saisie que cela me permettes de m'aider dans le genre 12/12/2000
j'ai trouver un code que Jai essayer de modifier
mais j'ai de temps en temps des erreurs c'est pourquoi j'ai mis le On error resume next mais de temps en temps ca ne fonctionne plus

quelqu'un pourrait t'il m'aider a l'adapter car les utilisateurs finals de ce classeurs ne connaissent rien sur Excel cest pourquoi je voudrais que dans les combobox des dates que ca puisses les aider ainsi..

merci de votre aide
Cordialement

ci joint mon code

Public Function ComBoboxDate(ByVal tdat As Object, ByVal KeyCode As MSForms.ReturnInteger, Optional mask As String = "dd/mm/yyyy", Optional charMASK As String = "_")
'MsgBox KeyCode
Dim txt$, X&, plus&, longg&, sep$, mask2$
On Error Resume Next
'construction du masque de saisie(mask2) en fonction de la chaine de format de date injectée
mask2 = Replace(Replace(Replace(mask, "d", charMASK), "m", charMASK), "y", charMASK)
sep = Left(Replace(mask2, charMASK, ""), 1) 'determine le caractere de separation
If tdat = "" Then tdat = mask2 'si textbox vide alors = mask2
txt = tdat.Value: If txt = mask2 Then tdat.SelStart = 0: tdat = ""
X = tdat.SelStart: longg = tdat.SelLength: If longg = 0 Then longg = 1
If KeyCode = 8 And longg > 1 Then KeyCode = 46
Select Case KeyCode
Case 96 To 105
If X = 10 Then KeyCode = 0: Exit Function
If Mid(mask2, X + 1, 1) = sep Then X = X + 1
Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): tdat = txt: plus = IIf(KeyCode < 96, 32, -48): 'reformate si plus de 1 caractere selectionné
Mid(txt, X + 1, 1) = Chr(KeyCode + plus): tdat = txt: tdat.SelStart = X + 1: KeyCode = 0
If Mid(tdat, X + 2, 1) = sep Then tdat.SelStart = X + 2

'control de validité de la date tapée a tout moment
Dim Pos1&, Pos2&, Part1$, Part2$, Part3$, PosX&
Select Case True 'determine les segment jours/mois/année et les positions selstart SELON le format injecté
Case Left(mask, 2) = "yy": Part2 = Mid(tdat, 6, 2): Part1 = Mid(tdat, 9, 2): Part3 = Mid(tdat, 1, 4): Pos1 = 8: Pos2 = 5: PosX = 8
Case Left(mask, 2) = "mm": Part2 = Mid(tdat, 1, 2): Part1 = Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos2 = 0: Pos1 = 3: PosX = 3
Case Left(mask, 2) = "dd": Part1 = Mid(tdat, 1, 2): Part2 = Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos1 = 0: Pos2 = 3: PosX = 3
End Select

'on ne peut depasser 31 pour les jours et 12 pour le mois quelque soit le format
If Val(Part1) > 31 Or Val(Left(Part1, 1)) > 3 Or Part1 = "00" Then tdat.SelStart = Pos1: tdat.SelLength = 2: Beep: Exit Function
If Val(Part2) > 12 Or Val(Left(Part2, 1)) > 1 Or Part2 = "00" Then tdat.SelStart = Pos2: tdat.SelLength = 2: Beep: Exit Function

'quand jour et mois sont rempli on teste avec l'annéee 2000(année bissextile pour fevrier)et 30 ou 31 pour les autres mois
If IsDate(Part1 & "/" & Part2) Then If Not IsDate(Part1 & "/" & Part2 & "/2000") Then tdat.SelStart = PosX: tdat.SelLength = 2: Beep

If Not IsDate(tdat) And InStr(tdat, charMASK) = 0 Then 'si plus de caracteres mask on teste la date complete
tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 4: Beep: Exit Function
Else
'pour pallier a l'erreur de isdate pour les année inferieur a 100 pour fevrier
If IsDate(tdat) Then If Year(CDate(tdat)) <> Val(Part3) Then tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 4: Beep
End If

Case 8 'touche BACK (Retour en arrière)
If X = 0 Then
KeyCode = 0
Else

If X <> 0 Then Mid(txt, X, longg + 1) = Mid(mask2, X, longg + 1)
tdat = txt: tdat.SelStart = X - 1: KeyCode = 0
If tdat = mask2 Then tdat = ""
If Mid(txt, X - IIf(X > 1, 1, 0), 1) = sep Then tdat.SelStart = X - 2
End If

Case 46 'touche Suppr(supprimer)
Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): KeyCode = 0: tdat = txt: tdat.SelStart = X 'touche Suppr

Case 37
If tdat = "" Or X = 0 Then
Else
tdat.SelStart = X - 1 'touche fleche gauche
End If

Case 39: tdat.SelStart = X + 1 'touche fleche droite

Case 13 Or 9 ' ce que l'on veux c'est la sortie

Case Else: KeyCode = 0 'touche les autres touches sont exclues
End Select

End Function
 

patricktoulon

XLDnaute Barbatruc
bonjour
et oui c'est toujours compliqué de re adapter un code
par contre ces codes sont prévus pour un textbox
pour un combobox je n'en vois pas l'utilité sachant que la sélection est automatique et que si ça ne correspond pas l'index reviend a -1
après un combo pour avoir tout les jours d'un mois c'est moyen
en effet il y a mon calendar et bien d'autres aussi

bref c'est une drole d'adaptation de mes codes de la collection textbox formatés
qui ne peut fonctionner correctement bien sur en tout cas tel que ca a été fait

pour le combobox il suffit de tester l'index
 

aurelio.ewane

XLDnaute Occasionnel
bonjour
et oui c'est toujours compliqué de re adapter un code
par contre ces codes sont prévus pour un textbox
pour un combobox je n'en vois pas l'utilité sachant que la sélection est automatique et que si ça ne correspond pas l'index reviend a -1
après un combo pour avoir tout les jours d'un mois c'est moyen
en effet il y a mon calendar et bien d'autres aussi

bref c'est une drole d'adaptation de mes codes de la collection textbox formatés
qui ne peut fonctionner correctement bien sur en tout cas tel que ca a été fait

pour le combobox il suffit de tester l'index
Merci Grand developeur de votre reponse en fait mon idée cetait de le faire fonctionner sur de Combobox et ensuite de pouvoir activer la touche Tabulation lorsquon est en fin de saisie priere de maider
 

Dranreb

XLDnaute Barbatruc
À mon avis ce n'est pas faux, que la saisie directe puisse être légèrement plus rapide que via un UFmCalend, mais de peu et c'est surtout moins confortable.
Le plus simple c'est de vérifier If Not IsDate(ComboBox.Text) Then Cancel = True dans une Sub ComboBox_Exit.
 

patricktoulon

XLDnaute Barbatruc
re
je ne sais pas avec le tiens @Dranreb mais j'ai testé avec le mien sur 50 textbox
(on peut le faire sur combo et label et commandbutton aussi)
et bien il n'y a pas photo


saisie avec séparateur auto +control de validité
VS
mon calendar c'est le calendar qui gagne


1° pas besoins de control de saisie puisqu'elle est valide en sortie de calendar

*un click sur le controls appelant(ouvre le calendar)
*un click sur les combo année et mois( selection)
*un click sur un des jours dispo

terminé la date est dans ton controls

je précise que j'ai testé la saisie avec mon code original que notre ami a essayé d'adapter
sauf que ma version fonctionne bien sur
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Ça fait trois clics, sans compter les déplacements de la souris. Mon UFmCalend est pensé pour être aussi pilotable sans la souris, par touches de déplacement, touche Tab, validation par Entré et fermeture sans saisie par Echap. C'est pratiquement aussi rapide qu'une simple saisie, mais sans plus.
 

patricktoulon

XLDnaute Barbatruc
re
oui le mien aussi a les touches raccourci pour les combo et la touche esc pour escape(annulation)
mais bon je pense que tu a raison sur l'exit

mais je le redis aussi saisir une date dans un combo ca veut dire qu'elle est sensée y etre dans la combo

parti de la avec le mathentry il y a l'autocomplétion et le select automatique si elle existe

donc je ne vois pas l'intérêt de faire un control de saisie
dans le change
if macombo.listindex>-1 then 'point barre (ce qui est finalement bien un control de saisie)
 

aurelio.ewane

XLDnaute Occasionnel
re
je ne sais pas avec le tiens @Dranreb mais j'ai testé avec le mien sur 50 textbox
(on peut le faire sur combo et label et commandbutton aussi)
et bien il n'y a pas photo


saisie avec séparateur auto +control de validité
VS
mon calendar c'est le calendar qui gagne


1° pas besoins de control de saisie puisqu'elle est valide en sortie de calendar

*un click sur le controls appelant(ouvre le calendar)
*un click sur les combo année et mois( selection)
*un click sur un des jours dispo

terminé la date est dans ton controls

je précise que j'ai testé la saisie avec mon code original que notre ami a essayé d'adapter
sauf que ma version fonctionne bien sur
daccord boss
 

Discussions similaires

Réponses
4
Affichages
279
Réponses
17
Affichages
1 K

Statistiques des forums

Discussions
313 315
Messages
2 097 067
Membres
106 825
dernier inscrit
benoit49