Sélection et mise en surbrillance de ligne et colonne avec intersection clignotante

[anthoYS]

bonjour,


en m'appuyant sur une discussion précédente j'ai tenter d'implanter un code, mais chez moi, sur mon fichier ça cloche, j'ai voulu imbriquer des codes, mais sans succès.

si quelqu'un peut examiner ça. Merci.

Option ExplicitPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$A$2" Then Target.Value = Date - 1: Cancel = True
Cancel = True
If Not Application.Intersect(Target, [F45:IV70]) Is Nothing Then Target.Interior.ColorIndex = IIf(Target.Interior.ColorIndex = 4, xlNone, 4)
'target est colorée
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)
With Target
   If .Column = 2 Then
Cancel = True
        If .Comment Is Nothing Then
            .AddComment
            .Comment.Shape.Width = 150.5
            .Comment.Shape.Height = 245.75
        End If
        SendKeys "%im"
    End If
End With
If IsError([Sel]) Then Exit Sub
Cancel = True
Efface
ThisWorkbook.Names("Inter").Delete
End Sub


Option Explicit




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

à+

 

[Gelinotte]

Re : En m'appuyant sur une discussion précédente, j'ai tenté d'implanter un code, ça

Bonjour,

If Target.Address = "$A$2"

A1:A2 sont fusionnées. Il devient donc difficile d'accéder à A2 pour le double-clics.

G