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
| Dim Lig As Long, DerLig As Long, n As Long, i As Long, Valeur As Long
Private Sub Worksheet_Change(ByVal Target As Range)
If Reinit = True Then Exit Sub
If Target.Column = 1 Then
Application.ScreenUpdating = False
'Application.EnableCancelKey = xlDisabled 'pour que l'utilisateur ne puisse pas interrompre la macro
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
If Target.Count = 1 Then
Valeur = Target
Target.Interior.Color = RGB(83, 142, 213)
Eff_MemeNum_DejaOrange
Target.Interior.Color = RGB(255, 192, 0)
Recalcul
Orange_vers_bleu
End If
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End If
End Sub
Sub Recalcul()
n = 1
DerLig = Range("A" & Rows.Count).End(xlUp).Row
'on efface toutes les valeurs qui ne sont pas sur fond orange
For j = 1 To DerLig
If Cells(j + 3, "A").Interior.Color <> RGB(255, 192, 0) Then Cells(j + 3, "A") = ""
Next j
For i = 4 To DerLig
Set c = Range("A4:A" & DerLig).Find(n, lookat:=xlWhole)
If c Is Nothing Then
If Cells(i, "A").Interior.Color <> RGB(255, 192, 0) Then
Cells(i, "A") = n
Else
n = n - 1
End If
Else
i = i - 1
End If
n = n + 1
Next i
End Sub
Sub Eff_MemeNum_DejaOrange()
If Valeur <> 0 Then
For j = 1 To DerLig
n = 1
If Cells(j + 3, "A").Interior.Color = RGB(255, 192, 0) And Cells(j + 3, "A") = Valeur Then
Cells(j + 3, "A") = ""
Cells(j + 3, "A").Interior.Color = RGB(83, 142, 213)
End If
Next j
End If
End Sub
Sub Orange_vers_bleu() 'si la valeur modifiée revient à sa position d'origine
For i = 4 To DerLig
If Cells(i, "A").Value + 3 = i Then Cells(i, "A").Interior.Color = RGB(83, 142, 213)
Next i
End Sub |
Partager