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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
| Public feuille As Integer
Public lr As Integer
Public lastrow As Integer
Private Sub UserForm_Initialize()
feuille = Year(Date)
Sheets("" & feuille & "").Activate
FiltresNeutres
End Sub
Private Sub CommandButton1_Click() 'Bouton Fermer
Unload Me
End Sub
Private Sub ComboBox_pompe_Change()
TextBox_val.Value = ""
TextBox_val.Enabled = False
lr = VerifModele
End Sub
Function VerifModele() As Integer
With Sheets("" & feuille & "") 'dans la feuille de l'année en cours
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
Set modele_existe = .Range("B7:B" & lastrow).Find(Me.ComboBox_pompe.Value, lookat:=xlWhole) 'on regarde déjà si le numéro existe dans la feuille
If modele_existe Is Nothing Then
TextBox_val.Enabled = True
VerifModele = lastrow + 1
Else: TextBox_val.Value = "Ne pas saisir"
VerifModele = modele_existe.Row
End If
End With
End Function
Private Sub CommandButton2_Click() 'bouton Ajouter
Application.ScreenUpdating = False
Dim modele As String
Dim no_ligne As Long
Dim fl As Worksheet
For i = 1 To 5 'on commence par passer tous les labels en Noir par défaut
Me.Controls("Label" & i).ForeColor = RGB(0, 0, 0)
Next i
'on vérifie d'abord que toutes les infos sont saisies: Si manquante: on passe le label en Rouge
If ComboBox_pompe.Value = "" Then
Label1.ForeColor = RGB(255, 0, 0)
ManqueInfo = "Modèle de pompe"
End If
If TextBox_serie.Value = "" Then
Label2.ForeColor = RGB(255, 0, 0)
ManqueInfo = ManqueInfo & " - " & "N° Série"
End If
If TextBox_MES.Value = "" Then
Label3.ForeColor = RGB(255, 0, 0)
ManqueInfo = ManqueInfo & " - " & "Date de MES"
End If
If TextBox_etalonnage.Value = "" Then
Label4.ForeColor = RGB(255, 0, 0)
ManqueInfo = ManqueInfo & " - " & "Dernier étalonnage"
End If
If TextBox_kalilab.Value = "" Then
Label5.ForeColor = RGB(255, 0, 0)
ManqueInfo = ManqueInfo & " - " & "Kalilab"
End If
If ManqueInfo <> "" Then 's'il manque quelque chose.. on l'indique et on quitte la macro
MsgBox "Manque les infos suivantes:" & Chr(10) & ManqueInfo
Exit Sub
End If
'AVANT de copier, on regarde s'il existe déjà dans une des feuilles le n° Kalilab OU le numéro de Série
For Each fl In Worksheets 'pour chaque feuille
If IsNumeric(fl.Name) Then 'si le nom est numerique
If fl.Name >= Year(Date) Then 'si le numero est sup/egal à l'année en cours
With fl
'*************************insertion d'1 nouvelle ligne en reprenant les formules existantes****************************
.Rows(lr).Copy 'on copie la dernière ligne
.Rows(lr).Insert shift:=xlDown 'on ABAISSE la dernière ligne pour insérer la copie --> les formules qui utilisent la dernière ligne se mettent donc à jour
Application.CutCopyMode = False
.Rows(lr).ClearContents 'on efface la dernière ligne pour permettre de coller les nouvelles données
.Rows(lr).ClearComments
.Rows(lr).Interior.ColorIndex = 2
.Range("A" & lr) = TextBox_kalilab.Value 'on rentre les valeurs
.Range("B" & lr) = ComboBox_pompe.Value
.Range("C" & lr) = TextBox_serie.Value
.Range("D" & lr) = CDate(TextBox_MES.Value)
.Range("F" & lr) = CDate(TextBox_etalonnage.Value)
.Range("N" & lr) = ComboBox_prop.Value
If TextBox_val.Enabled = True Then
'Range("L" & lr).Select
' /*/*/*/*/*/*//*/*/*/*/*/ ICI */*/*/*/*/*/*/*/
Range("L" & lr).Formula = "=" & TextBox_val.Value & "-(AUJOURDHUI()-(F" & lr & "))"
'Application.Calculate
'SendKeys "{F2}"
'SendKeys "{F9}"
'SendKeys "{ENTER}"
'Selection.NumberFormat = "General"
Else: .Range("L" & lr).Resize(2).FillUp
End If
If .Range("B" & lr).Comment Is Nothing And Not IsNumeric(.Range("B" & lr)) Then 'si il n'y pas de commentaire
.Range("B" & lr).AddComment 'on en met 1
Msg = "N° serie: " & .Range("C" & lr) & Chr(10) & "Date MES: " & .Range("D" & lr) & Chr(10) & "Date étalonnage: " & Chr(10) & .Range("F" & lr)
.Range("B" & lr).Comment.Text Text:=Msg
.Range("B" & lr).Comment.Shape.TextFrame.AutoSize = True
End If
End With
End If
End If
Next fl
'********************* on vide le formulaire *******************
ComboBox_pompe.Value = ""
TextBox_serie.Value = ""
TextBox_MES.Value = ""
TextBox_etalonnage.Value = ""
TextBox_kalilab.Value = ""
TextBox_val.Value = ""
ComboBox_prop.Value = ""
'UserFiltres
Application.ScreenUpdating = True
End Sub
Private Sub TextBox_serie_AfterUpdate()
With Sheets("" & feuille & "")
Set TrouveNumS = .Range("C8:C" & lastrow).Find(TextBox_serie.Value, lookat:=xlWhole) 'recherche n° Serie
If Not TrouveNumS Is Nothing Then 'si n° serie trouvé
MsgBox "N° série deja existant", vbExclamation + vbOKOnly, "alerte" 'message
Exit Sub ' on sort
End If
End With
End Sub
Private Sub TextBox_kalilab_AfterUpdate()
With Sheets("" & feuille & "")
Set TrouveKal = .Range("A8:A" & lastrow).Find(TextBox_kalilab.Value, lookat:=xlWhole) 'recherche n° Kalilab
If Not TrouveKal Is Nothing Then 'si n°kalilab trouvé
MsgBox "N° KALILAB deja existant", vbExclamation + vbOKOnly, "alerte" 'message
Exit Sub 'on sort
End If
End With
End Sub
Private Sub TextBox_val_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Interdire les lettres
If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
Private Sub TextBox_MES_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Interdire les lettres
If InStr("0123456789/", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
Private Sub TextBox_etalonnage_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Interdire les lettres
If InStr("0123456789/", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
Private Sub TextBox_MES_Change() 'pour controler la saisie d'une date au format dd/mm/yyyy
Dim valeur As Byte
valeur = Len(TextBox_MES)
If valeur = 2 Or valeur = 5 Then
TextBox_MES = TextBox_MES & "/" 'afficher "/" aprés la saisie des 2 premiers chiffres
End If 'ajouter test pour vérifier la validité de la date saisie !
If valeur = 10 Then
If ((Split(TextBox_MES, "/")(0) > 31) Or (Split(TextBox_MES, "/")(1) > 12) Or (Split(TextBox_MES, "/")(2) < 1900)) Then
TextBox_MES = ""
MsgBox "La date est fausse", vbOKOnly, "MES"
Exit Sub
End If
End If
End Sub
Private Sub TextBox_etalonnage_Change() 'pour controler la saisie d'une date au format dd/mm/yyyy
Dim valeur As Byte
valeur = Len(TextBox_etalonnage)
If valeur = 2 Or valeur = 5 Then
TextBox_etalonnage = TextBox_etalonnage & "/" 'afficher "/" aprés la saisie des 2 premiers chiffres
End If
'ajouter test pour vérifier la validité de la date saisie !
If valeur = 10 Then
If ((Split(TextBox_etalonnage, "/")(0) > 31) Or (Split(TextBox_etalonnage, "/")(1) > 12) Or (Split(TextBox_etalonnage, "/")(2) < 1900)) Then
TextBox_etalonnage = ""
MsgBox "La date est fausse", vbOKOnly, "etalonnage"
End If
End If
End Sub
Private Sub ComboBox_prop_Change() 'on force la majuscule
ComboBox_prop.Text = UCase(ComboBox_prop.Text)
End Sub
Private Sub TextBox_serie_Change() 'on force la majuscule
TextBox_serie.Text = UCase(TextBox_serie.Text)
End Sub
Private Sub TextBox_kalilab_Change() 'on force la majuscule
TextBox_kalilab.Text = UCase(TextBox_kalilab.Text)
End Sub
Private Sub TextBox_MES_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'controle du format de date
If Len(TextBox_MES) <> 0 And Len(TextBox_MES) <> 10 Then
MsgBox "date au format jj/mm/aaaa", vbInformation + vbOKOnly, "etalonnage"
TextBox_MES = ""
Cancel = True
End If
End Sub
Private Sub TextBox_etalonnage_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'controle du format de date
If Len(TextBox_etalonnage) <> 0 And Len(TextBox_etalonnage) <> 10 Then
MsgBox "date au format jj/mm/aaaa", vbInformation + vbOKOnly, "etalonnage"
TextBox_etalonnage = ""
Cancel = True
End If
End Sub
Sub compile_comment() 'permet d'ajouter un commenaire sur toutes les cellules de la colonne B avec N° serie / Date de MES / date d'etalonnage
With ActiveSheet
fin = .Range("B" & .Rows.Count).End(xlUp).Row 'on trouve la derniere ligne
For i = 8 To fin
If .Range("B" & i).Comment Is Nothing And Not IsEmpty(.Range("B" & i)) Then
.Range("B" & i).AddComment
Msg = "N° serie: " & .Range("C" & i) & Chr(10) & "Date MES: " & .Range("D" & i) & Chr(10) & "Date étalonnage: " & .Range("E" & i)
.Range("B" & i).Comment.Text Text:=Msg
.Range("B" & i).Comment.Shape.TextFrame.AutoSize = True
End If
Next i
End With
End Sub |
