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
| Private Sub CommandButton1_Click()
Dim l_info As Integer
Dim l As Integer
Dim note_1 As String, note_2 As String, lanote As String
Dim ws As Worksheet
Dim ds As Worksheet
'protection feuille
Dim cell As Range
Dim pl As Range
Worksheets("TABLEAU RECAP").Visible = True
Worksheets("TABLEAU RECAP").Unprotect ("cedric")
Sheets("TABLEAU RECAP").Cells.Locked = True
For Each cell In Sheets("TABLEAU RECAP").Range("M2")
If cell.MergeCells = True Then
Set pl = cell.MergeArea
cell.UnMerge
cell.Locked = False
pl.Merge
Else
cell.Locked = False
End If
Next cell
Worksheets("TABLEAU RECAP").Protect ("cedric"), DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
With ThisWorkbook.Worksheets("TABLEAU RECAP")
l_info = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
.Range("B" & l_info).Value = ComEQUI 'libelle equipement'
.Range("c" & l_info).Value = Textlocal 'code local"
.Range("D" & l_info).Value = ComRESP 'Nom du responsable'
.Range("E" & l_info).Value = CDate(TextDATEAM) 'date du constat'
.Range("F" & l_info).Value = CDate(TextMISE) 'date de mise en service'
.Range("G" & l_info).Value = CInt(TextDUREVIE.Value) 'Duree de vie theorique'
.Range("H" & l_info).Value = CDate(TextREMPL) 'Date theorique de remplacement '
.Range("I" & l_info).Value = CInt(TextDURVIERESI.Value) 'Duree de vie residuelle '
.Range("J" & l_info).Value = TextESTIMREMPL 'Duree de vie residuelle '
.Range("K" & l_info).Value = CInt(TextRESUETAT.Value) 'note de etat equipement'
.Range("l" & l_info).Value = CInt(TextRESUCRIT.Value) 'note de criticite equipement'
If CheckBox1.Value Then
'cas case cochee
.Range("p" & l_info).Value = "x"
.Range("q" & l_info).Value = CDate(Textboxdatechange) 'date de remplacement équipement
MsgBox ("attention imformer au equipe gmao le changement de l'equipement")
Else
'cas case non cochee
'rien ?
End If
If UserFormpri.CheckBox1.Value = True Then
UserForm2.TextBox6.Value = Me.ComEQUI.Value 'colle valeur équipement dans le texbox de l'uesrform2 et l'appeler
UserForm2.Show
Else
'rien
End If
With .Range("M" & l_info)
'formulation
.FormulaR1C1 = "=IF(RC[-2]<=21,""Mauvais"",IF(RC[-2]<=43,""Usuel"",IF(RC[-2]<=64,""Bon"")))"
'équivaut à un collage spécial valeur
.Value = .Value
note_1 = .Value
End With
With .Range("N" & l_info)
'formulation
.FormulaR1C1 = "=IF(RC[-2]<=21,""Faible"",IF(RC[-2]<=43,""Moyenne"",IF(RC[-2]<=64,""Forte"")))"
'équivaut à un collage spécial valeur
.Value = .Value
note_2 = .Value
End With
Select Case True
Case note_1 = "Mauvais" And note_2 = "Faible"
lanote = "B"
Case note_1 = "Mauvais" And note_2 = "Moyenne"
lanote = "C"
Case note_1 = "Mauvais" And note_2 = "Forte"
lanote = "C"
Case note_1 = "Usuel" And note_2 = "Faible"
lanote = "A"
Case note_1 = "Usuel" And note_2 = "Moyenne"
lanote = "B"
Case note_1 = "Usuel" And note_2 = "Forte"
lanote = "B"
Case note_1 = "Bon" And note_2 = "Faible"
lanote = "A"
Case note_1 = "Bon" And note_2 = "Moyenne"
lanote = "A"
Case note_1 = "Bon" And note_2 = "Forte"
lanote = "A"
End Select
.Range("O" & l_info).Value = lanote 'donne de la note dans le tableau recap
'si mon chexbox est cocher et que la note est superieur a l'annee d'avant message et fermeture de userform et sans validation dans le tableau recap
Set ds = ThisWorkbook.Worksheets("Donnée équipement")
l = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
ds.Range("G" & l).Value = lanote
Set ws = ThisWorkbook.Worksheets("TABLEAU RECAP")
l_info = ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
If ws.Range("O" & l_info).Value > lanote And CheckBox1.Value = False Then
If MsgBox("Note différente de l'année dernière", vbOK Or vbCancel) = vbOK Or vbCancel Then
Sheets("TABLEAU RECAP").Range("b" & Sheets("TABLEAU RECAP").Range("b65000").End(xlUp).Row).EntireRow.ClearContents
MsgBox ("Recommencer l'evaluation")
End If
Set ds = ThisWorkbook.Worksheets("Donnée équipement")
l = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
If ds.Range("G" & l).Value = lanote = lanote And CheckBox1.Value = False Then
ds.Range("G" & l).Value = lanote
End If
Set ds = ThisWorkbook.Worksheets("Donnée équipement")
l = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row 'si la note est inferieur a la donne de G "donne equipement" et chexbox pas coché rien faire
If ds.Range("G" & l).Value < lanote And CheckBox1.Value = False Then
End If
Set ds = ThisWorkbook.Worksheets("Donnée équipement")
l = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row 'si la note est superieur a la donne dans G "donnée equipement" et chexbx coché
If ds.Range("G" & l).Value < lanote And CheckBox1.Value = True Then
ds.Range("G" & l).Value = lanote
End If
End If
End With
Call CreationBouton 'creation du bouton dans le tableau recap
Me.hide
Unload UserFormpri
End Sub |
Partager