Colore di sfondo su cella attivata.

Question

Ciao,

ho la seguente situazione:

Su attivazione di una delle celle L6 : L25 oltre a colorarsi di sfondo giallo la cella medesima attivata (nell'esempio L12), si dovrebbe colorare di sfondo giallo anche la cella appartenente allo stesso rigo appartenente alla colonna E (nell'esempio E12) in cui già esiste una formattazione.

Finora, tramite la seguente routine sono riuscito a colorare solo le celle appartenenti alla colonna L :

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Rng As Range

Const sIntervallo As String = "L6:L25"

Set Rng = Me.Range(sIntervallo)

Set Target = Intersect(ActiveCell, ActiveSheet.Range(sIntervallo))

    If Not Target Is Nothing Then

        With Target

            .FormatConditions.Add xlExpression, , False

        End With

    End If

    With Rng

        .FormatConditions.Delete

    End With

    If Not Target Is Nothing Then

        With Target

            .FormatConditions.Add xlExpression, , True

            .FormatConditions(1).Interior.Color = RGB(255, 255, 0)

        End With

    End If

End Sub

Vladimiro

Answer 1

Ciao Vladimiro,

 si dovrebbe colorare di sfondo giallo anche la cella appartenente allo stesso rigo appartenente alla colonna E (nell'esempio E12) in cui già esiste una formattazione.

come riportato in grassetto, nell'intervallo di celle E6 : E25 (dove il colore del carattere è bianco come lo sfondo) esiste la seguente formattazione:

se il valore della cella è > 0 formatta lo sfondo e il carattere.

Succede dunque che al primo click, scompare la formattazione preesistente:

Ecco la necessità del mio codice forse un po' ridondante ma che riesce ad evitare questo problema.

Solo che poi non ho trovato il modo di far accendere di giallo la cella nella colonna E

[...]

questo è il link da cui puoi scaricare il file.

Approfitto per chiederti un'ulteriore cosa, sempre se è possibile e cioè la possibilità di fare la stessa cosa anche per gli altri due programmini clonati inseriti sotto.

Nel modulo di codice del foglio di interesse, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Rng As Range, Rng2 As Range

    Dim Rng3 As Range, Rng4 As Range

    Dim i As Long, iCtr As Long

    Const sIntervallo As String = "L6:L25,L32:L51,L58:L77"

    Const sIntervallo2 As String = "E6:E25,E32:E51,E58:E77"

    If Target.Cells.Count > 1 Then

        Exit Sub

    End If

    Set Rng = Me.Range(sIntervallo)

    For i = 1 To Rng.Areas.Count

        iCtr = iCtr + 1

        If Not Intersect(Rng.Areas(i), Target) Is Nothing Then

            Exit For

        End If

    Next i

    Set Rng2 = Me.Range(sIntervallo2).Areas(iCtr)

    Set Rng3 = Intersect(Target, Rng)

    Application.ScreenUpdating = False

    With Union(Rng.Areas(iCtr), Rng2)

        .FormatConditions.Delete

    End With

    Call SetFormat(Rng2)

    If Not Rng3 Is Nothing Then

        With Union(Rng3, Rng3.Offset(0, -7))

            .FormatConditions.Delete

            If Rng3.Cells(1).Offset(0, -9).Value > 0 Then

                .FormatConditions.Add xlExpression, , True

                .FormatConditions(1).Font.Color = vbBlack

                .FormatConditions(1).Interior.Color = vbYellow

            End If

        End With

    End If

    With Application

        .EnableEvents = False

        rCell.Select

        .EnableEvents = True

        .ScreenUpdating = True

    End With

End Sub

'<<=========

In un modulo di codice standard, incolla :

'=========>>

Option Explicit

Public rCell As Range

Sub SetFormat(aRng As Range)

    Set rCell = Selection

    With Application

        .ScreenUpdating = False

        .EnableEvents = False

    End With

    aRng.Select

    Application.EnableEvents = True

    aRng.FormatConditions.Add Type:=xlExpression, Formula1:= _

                              "=" & aRng.Offset(0, -2).Address(0, 0) & ">0"

    aRng.FormatConditions(aRng.FormatConditions.Count).SetFirstPriority

    With aRng.FormatConditions(1).Font

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

    End With

    With aRng.FormatConditions(1).Interior

        .Pattern = xlPatternLinearGradient

        .Gradient.Degree = 90

        .Gradient.ColorStops.Clear

    End With

    With aRng.FormatConditions(1).Interior.Gradient.ColorStops.Add(0)

        .Color = 15773696

        .TintAndShade = 0

    End With

    With aRng.FormatConditions(1).Interior.Gradient.ColorStops.Add(0.5)

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = 0

    End With

    With aRng.FormatConditions(1).Interior.Gradient.ColorStops.Add(1)

        .Color = 15773696

        .TintAndShade = 0

    End With

    aRng.FormatConditions(1).StopIfTrue = False

End Sub

'<<=========

Potresti scaricare il file di prova Vladimiro20191212.xlsm

===

Regards,

Norman

Answer 2

 si dovrebbe colorare di sfondo giallo anche la cella appartenente allo stesso rigo appartenente alla colonna E (nell'esempio E12) in cui già esiste una formattazione.

Purche' tu voglia sfruttare la formattazione condizionale, prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Rng As Range, Rng2 As Range

    Const sIntervallo As String = "L6:L25"

    Set Rng = Me.Range(sIntervallo)

    Set Rng2 = Intersect(Target, Rng)

    With Union(Rng, Rng.Offset(0, -7))

        .FormatConditions.Delete

    End With

    If Not Rng2 Is Nothing Then

        With Union(Rng2, Rng2.Offset(0, -7))

            .FormatConditions.Add xlExpression, , True

            .FormatConditions(1).Interior.Color = RGB(255, 255, 0)

        End With

    End If

End Sub

'<<========= 

===

Regards,

Norman

Ciao Norman,

come riportato in grassetto, nell'intervallo di celle E6 : E25 (dove il colore del carattere è bianco come lo sfondo) esiste la seguente formattazione:

se il valore della cella è > 0 formatta lo sfondo e il carattere.

Succede dunque che al primo click, scompare la formattazione preesistente:

Ecco la necessità del mio codice forse un po' ridondante ma che riesce ad evitare questo problema.

Solo che poi non ho trovato il modo di far accendere di giallo la cella nella colonna E.

Vladimiro

Answer 3

Ciao Vladimiro,

ho la seguente situazione:

Su attivazione di una delle celle L6 : L25 oltre a colorarsi di sfondo giallo la cella medesima attivata (nell'esempio L12), si dovrebbe colorare di sfondo giallo anche la cella appartenente allo stesso rigo appartenente alla colonna E (nell'esempio E12) in cui già esiste una formattazione.

Finora, tramite la seguente routine sono riuscito a colorare solo le celle appartenenti alla colonna L :

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Rng As Range

Const sIntervallo As String = "L6:L25"

Set Rng = Me.Range(sIntervallo)

Set Target = Intersect(ActiveCell, ActiveSheet.Range(sIntervallo))

    If Not Target Is Nothing Then

        With Target

            .FormatConditions.Add xlExpression, , False

        End With

    End If

    With Rng

        .FormatConditions.Delete

    End With

    If Not Target Is Nothing Then

        With Target

            .FormatConditions.Add xlExpression, , True

            .FormatConditions(1).Interior.Color = RGB(255, 255, 0)

        End With

    End If

End Sub

Purche' tu voglia sfruttare la formattazione condizionale, prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Rng As Range, Rng2 As Range

    Const sIntervallo As String = "L6:L25"

    Set Rng = Me.Range(sIntervallo)

    Set Rng2 = Intersect(Target, Rng)

    With Union(Rng, Rng.Offset(0, -7))

        .FormatConditions.Delete

    End With

    If Not Rng2 Is Nothing Then

        With Union(Rng2, Rng2.Offset(0, -7))

            .FormatConditions.Add xlExpression, , True

            .FormatConditions(1).Interior.Color = RGB(255, 255, 0)

        End With

    End If

End Sub

'<<========= 

===

Regards,

Norman

Answer 4

Piccola correzione: ho scritto erroneamente vbRed invece che vbYellow nell'ultima riga prima di End If.

Answer 5

Buona sera,

La procedura che riporto qui sotto dovrebbe fare quello da Lei richiesto.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim rng As Range
    Dim ints As Range
    Dim rw As Integer

    Set rng = Range("L6:L25")
    Set ints = Intersect(Target, rng)
    
    If Not ints Is Nothing Then
        Cells(ints.Row, ints.Column).Interior.Color = vbYellow
        rw = ints.Row
        Cells(rw, 5).Interior.Color = vbRed
    End If

End Sub

Mi faccia sapere se non funziona o non è esattamente quello che voleva.

Saluti,

Paolo