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
| Private cellColl As Collection
' collection qui va gérer le nombre de double-clics par cellule
Private Sub Worksheet_Activate()
Set cellColl = New Collection
Debug.Print "init"
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim clics As Integer
On Error GoTo NiceError
' on récupère le nombre de double clics pour la cellule en cours
' s'il n'y en a aucun ça lève une erreur (n°5) et on l'ajoute à la collection
' si pas d'erreur on ajoute 1 aux nombres de double clic et on colore en fonction
' de la plage "témoin" Colorz
clics = (cellColl(Target.AddressLocal(False, False))) Mod (Range("ColorZ").Rows.Count)
If clics = 0 Then
clics = 1
Else
clics = clics + 1
End If
cellColl.Remove (Target.AddressLocal(False, False))
cellColl.add Item:=clics, key:=Target.AddressLocal(False, False)
Target.Interior.Color = Range("colorz").Cells(clics, 1).Interior.Color
NiceExit:
' Cancel = true c'est pour éviter de passer en mode édition
Cancel = True
Exit Sub
NiceError:
Select Case Err.Number
Case 5
cellColl.add Item:=2, key:=Target.AddressLocal(False, False)
Target.Interior.Color = Range("colorz").Cells(2, 1).Interior.Color
Case Else
MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly
End Select
Err.Clear
GoTo NiceExit
End Sub
Private Sub Worksheet_Deactivate()
Set cellColl = Nothing
Debug.Print "Deinit"
End Sub |
Partager