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 |
Partager