Problème tri des Dates après un Userform

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

je réalise un remplissage d'une TextBox via 3 ComboBox afin de rentrer une Date.
une fois le tout remplie et le Userform Fermé la date ne doit pas être au bon format puisque je dois obligatoirement double cliquer dessus et faire ENTRER pour qu'elle entre bien en Trie comme les autres.
J'ai tenté d'écrire manuellement la date dans la TextBox en question ( Textbox22 avec une syntaxe : 12/12/2013 ) et même problème

J'ai tenter de faire une macro " DOUBLE CLICK puis ENTRER" mais je n'y suis pas parvenu.

Pièce jointe 220506

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 TextBox22.Value = (ComboBox1.Value & ComboBox2.Value & ComboBox3.Value) 'TextBox22=date dans colonne A
 
Private Sub UserForm_Initialize()
 
ComboBox1.Style = fmStyleDropDownList ' oblige l'utilisateur à mettre une des valeurs de la liste
ComboBox1.AddItem ("01/")
ComboBox1.AddItem ("02/")
ComboBox1.AddItem ("03/")
ComboBox1.AddItem ("04/")
ComboBox1.AddItem ("05/")
ComboBox1.AddItem ("06/")
ComboBox1.AddItem ("07/")
ComboBox1.AddItem ("08/")
ComboBox1.AddItem ("09/")
ComboBox1.AddItem ("10/")
ComboBox1.AddItem ("11/")
ComboBox1.AddItem ("12/")
ComboBox1.AddItem ("13/")
ComboBox1.AddItem ("14/")
ComboBox1.AddItem ("15/")
ComboBox1.AddItem ("16/")
ComboBox1.AddItem ("17/")
ComboBox1.AddItem ("18/")
ComboBox1.AddItem ("19/")
ComboBox1.AddItem ("20/")
ComboBox1.AddItem ("21/")
ComboBox1.AddItem ("22/")
ComboBox1.AddItem ("23/")
ComboBox1.AddItem ("24/")
ComboBox1.AddItem ("25/")
ComboBox1.AddItem ("26/")
ComboBox1.AddItem ("27/")
ComboBox1.AddItem ("28/")
ComboBox1.AddItem ("29/")
ComboBox1.AddItem ("30/")
ComboBox1.AddItem ("31/")
 
ComboBox2.Style = fmStyleDropDownList ' oblige l'utilisateur à mettre une des valeurs de la liste
ComboBox2.AddItem ("01/")
ComboBox2.AddItem ("02/")
ComboBox2.AddItem ("03/")
ComboBox2.AddItem ("04/")
ComboBox2.AddItem ("05/")
ComboBox2.AddItem ("06/")
ComboBox2.AddItem ("07/")
ComboBox2.AddItem ("08/")
ComboBox2.AddItem ("09/")
ComboBox2.AddItem ("10/")
ComboBox2.AddItem ("11/")
ComboBox2.AddItem ("12/")
 
ComboBox3.Style = fmStyleDropDownList ' oblige l'utilisateur à mettre une des valeurs de la liste
ComboBox3.AddItem ("2013")
ComboBox3.AddItem ("2014")
ComboBox3.AddItem ("2015")
ComboBox3.AddItem ("2016")
ComboBox3.AddItem ("2017")
ComboBox3.AddItem ("2018")
ComboBox3.AddItem ("2019")
ComboBox3.AddItem ("2020")
ComboBox3.AddItem ("2021")
ComboBox3.AddItem ("2022")
ComboBox3.AddItem ("2023")
ComboBox3.AddItem ("2024")
ComboBox3.AddItem ("2025")

17/09/2016, 13h58
Docmarti

Bonjour.

Quel est ton code qui ecrit la date sur la feuille ?

Désolé par avance si ce n'est pas le code le plus lisible que tu as lu ^^ je suis totalement novice dans le domaine

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Private Sub CommandButton1_Click()
 
Dim ctrl As Control
Dim Colonne As Integer
Dim DerLigne As Integer
 
 
DerLigne = Sheets("LISTE DE TIR").Range("A65000").End(xlUp).Row + 1 ' définie ce qu'est la dernière ligne écrite
' Permet de verifier si toutes les cases indispensables sont remplies
 
  If UserForm1.ComboBox1 = "" Or UserForm1.ComboBox2 = "" Or UserForm1.ComboBox3 = "" Or UserForm1.ComboBox4 = "" Or UserForm1.ComboBox5 = "" Or UserForm1.ComboBox6 = "" Or UserForm1.ComboBox7 = "" Or UserForm1.ComboBox8 = "" Or UserForm1.ComboBox9 = "" Or UserForm1.TextBox1 = "" Or UserForm1.TextBox2 = "" Or UserForm1.TextBox9 = "" Or UserForm1.TextBox10 = "" Or UserForm1.TextBox11 = "" Or UserForm1.TextBox12 = "" Or UserForm1.TextBox13 = "" Or UserForm1.TextBox14 = "" Or UserForm1.TextBox15 = "" Or UserForm1.TextBox16 = "" Or UserForm1.TextBox21 = "" Then
     MsgBox " INCOMPLET"
GoTo JumpToHere ' permet de sauter une étape
 
' permet de verifier dans le cas où le test est exploitable si les résultats sont bien rentrés
  End If
 
       TextBox22.Value = (ComboBox1.Value & ComboBox2.Value & ComboBox3.Value) 'TextBox22=date dans colonne A
       TextBox23.Value = (ComboBox4.Value & ":" & ComboBox5.Value)
 
       If UserForm1.ComboBox8 = "OUI" And (UserForm1.TextBox17 = "" Or UserForm1.TextBox18 = "" Or UserForm1.TextBox19 = "" Or UserForm1.TextBox20 = "") Then
     MsgBox " INCOMPLET"
GoTo JumpToHere ' permet de sauter une étape
End If
 
 
 
' permet de verifier dans le cas où le test est NON exploitable si les résultats sont bien rentrés
 
     For Each ctrl In UserForm1.Controls
     Colonne = Val(ctrl.Tag)
     If Colonne > 0 Then Sheets("LISTE DE TIR").Cells(DerLigne, Colonne) = ctrl 'ici contrôle de ça s'écrit où + écriture
     Sheets("LISTE DE TIR").Unprotect ' enlève la protection de la feuille
 
 
     Next
 
     ' fait la mise en page
 
     Derniereligne = Sheets("LISTE DE TIR").Range("A65000").End(xlUp).Rows.Select
     Call Macro1
     Selection.Offset(0, 1).Select
     Call Macro2
     Selection.Offset(0, 1).Select
     Call Macro3
     Selection.Offset(0, 1).Select
     Call Macro1
     Selection.Offset(0, 1).Select
     Call Macro2
     ActiveCell.Value = "h"
     Selection.Offset(0, 1).Select
     Call Macro3
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro1
     Selection.Offset(0, 1).Select
     Call Macro2
     ActiveCell.Value = "%"
     Selection.Offset(0, 1).Select
     Call Macro2
     Selection.Offset(0, 1).Select
     Call Macro2
     ActiveCell.Value = "+"
     Selection.Offset(0, 1).Select
     Call Macro2
     Selection.Offset(0, 1).Select
     Call Macro2
     ActiveCell.Value = "%"
     Selection.Offset(0, 1).Select
     Call Macro2
     Selection.Offset(0, 1).Select
     Call Macro2
     ActiveCell.Value = "+"
     Selection.Offset(0, 1).Select
     Call Macro2
     Selection.Offset(0, 1).Select
     Call Macro2
     ActiveCell.Value = "%"
     Selection.Offset(0, 1).Select
     Call Macro2
     Selection.Offset(0, 1).Select
     Call Macro2
     ActiveCell.Value = "+"
     Selection.Offset(0, 1).Select
     Call Macro2
     Selection.Offset(0, 1).Select
     Call Macro2
     ActiveCell.Value = "%"
     Selection.Offset(0, 1).Select
     Call Macro3
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, 1).Select
     Call Macro4
     Selection.Offset(0, -37).Select
              Unload UserForm1
Call ListeLecteursAmovible
JumpToHere:
 
 
    Sheets("LISTE DE TIR").Protect , AllowSorting:=True, AllowFiltering:=True
    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="E:\copy.xlsm" ' mettre un répertoire
    Application.DisplayAlerts = True
 
End Sub

Essaie comme ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
For Each ctrl In UserForm1.Controls
     Colonne = Val(ctrl.Tag)
     If Colonne > 0 Then
 
      Sheets("LISTE DE TIR").Unprotect ' enlève la protection de la feuille
 
     If IsDate(ctrl.Value) And Not IsNumeric(ctrl.Value) Then
 
      'Pour ecrire une date sur une feuille 
      Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).NumberFormat = ""
      Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).Value = Format(ctrl.Value, "yyyy-mm-dd")
 
     Else
 
      Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).NumberFormat = ""
      Sheets("LISTE DE TIR").Cells(DerLigne, Colonne) = ctrl 'ici contrôle de ça s'écrit où + écriture
 
     End If
 
    End If
 
   Next

17/09/2016, 17h30
schumi22000

Merci à toi, en effet cela fonctionne, malheureusement cela a fait foirer ma case HEURE.

il écrit mon heure en format DATE, ne serait il pas possible d'obliger la mise au format DATE seulement pour la première colonne ?
17/09/2016, 17h53
Docmarti

Mets

Code:

Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).FormulaLocal = CDate(ctrl.Value)

à la place de

Code:

Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).Value = Format(ctrl.Value, "yyyy-mm-dd")
17/09/2016, 18h03
schumi22000

alors super pour ce qui est de la date et de l'heure

en revanche toutes mes textbox sont hormis la date, au format Heure.
en realité j'ai seulement la colonne A en date, la colonne B en heure et le reste sont des chiffres décimaux

On va y arriver.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
   For Each ctrl In UserForm1.Controls
     Colonne = Val(ctrl.Tag)
     If Colonne > 0 Then
 
      Sheets("LISTE DE TIR").Unprotect ' enlève la protection de la feuille
 
     If IsDate(ctrl.Value) And Not IsNumeric(Replace(ctrl.Value, ".", Format(0, "."))) Then
      'dates ou heures
      Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).NumberFormat = ""
      Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).FormulaLocal = CDate(ctrl.Value)
 
     Else
 
 
     If IsNumeric(Replace(ctrl.Value, ".", Format(0, "."))) Then
      'Valeur numerique
       Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).NumberFormat = ""
       Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).Value = CDbl(Replace(ctrl.Value, ".", Format(0, ".")))
     Else
      'Valeur non numerique
      Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).NumberFormat = ""
      Sheets("LISTE DE TIR").Cells(DerLigne, Colonne).Value = ctrl.Value
    End If
 
   End If
 
  End If
 
   Next

18/09/2016, 11h42
schumi22000

merci à toi tout fonctionne parfaitement.

je vais créer un autre poste pour un autre soucis, si tu as aussi l'info je suis preneur de tes conseils :)