Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim flag As Boolean, zone As Range, cel As Range
If Intersect(Target, [Tableau]) Is Nothing Then Exit Sub
Cancel = True
Efface
If IsError([Inter]) Then
flag = True '=> pas d'annulation
Set zone = Target
Else
flag = Intersect(Target, [Inter]) Is Nothing 'True => pas d'annulation
Set zone = Union(Target, [Inter])
ThisWorkbook.Names("Inter").Delete
If zone.Count = 1 Then Exit Sub
End If
For Each cel In zone
If cel.Address <> Target.Address Or flag Then
If IsError([Sel]) Then Set zone = cel Else Set zone = [Sel]
Intersect([Tableau], Union(zone, cel.EntireRow, cel.EntireColumn)).Name = "Sel"
If IsError([Inter]) Then Set zone = cel Else Set zone = [Inter]
Union(zone, cel).Name = "Inter"
End If
Next
With [Sel]
.FormatConditions.Delete
.FormatConditions.Add xlExpression, Formula1:="=OU(LIGNE()=1;COLONNE()=28)"
.FormatConditions(1).Interior.ColorIndex = 3 'rouge
.FormatConditions(1).Font.ColorIndex = 2 'blanc
.FormatConditions(1).Font.Bold = True 'gras
.FormatConditions.Add xlExpression, Formula1:="=OU(LIGNE()=2;COLONNE()=30)"
.FormatConditions(2).Interior.ColorIndex = 5 'bleu
.FormatConditions(2).Font.ColorIndex = 2 'blanc
.FormatConditions(2).Font.Bold = True 'gras
.FormatConditions.Add xlExpression, Formula1:=True
.FormatConditions(3).Interior.ColorIndex = 1 'noir
.FormatConditions(3).Font.ColorIndex = 2 'blanc
.FormatConditions(3).Font.Bold = True 'gras
End With
With [Inter]
.FormatConditions.Delete
.FormatConditions.Add xlCellValue, xlEqual, "="""""
.FormatConditions(1).Interior.ColorIndex = 16 'gris foncé
.FormatConditions.Add xlExpression, Formula1:=True
.FormatConditions(2).Font.Bold = True 'gras
'---clignotement---
affiche = False
Clignote
End With
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If IsError([Sel]) Then Exit Sub
Cancel = True
Efface
ThisWorkbook.Names("Inter").Delete
End Sub
Private Sub Efface()
Application.ScreenUpdating = False
[Tableau].FormatConditions.Delete
[A1:AA1].FormatConditions.Add xlCellValue, xlGreater, 1
[A1:AA1].FormatConditions(1).Font.ColorIndex = 3 'rouge
'[A1:AA1].FormatConditions(1).Font.Bold = True 'gras 'inutile...
If Not IsError([Sel]) Then ThisWorkbook.Names("Sel").Delete
End Sub