Creare sfondo lampeggiante.

Question

Ciao,

nel momento in cui una cella (o un unione celle) raggiunge dei requisiti e si colora, tramite formattazione condizionale, di un colore diverso dal grigio predefinito, ad esempio di colore rosso o di colore verde, è possibile farlo "lampeggiare", magari alternando due colori, ad esempio rosso e bianco per il rosso e verde e bianco per il verde?

Al seguente link c'è una demo contenente un piccolo esempio per agevolare chi, cortesemente, vuole darmi una mano.

Vladimiro

Answer 1

Ciao Vladimiro,

ok, ho capito.

Entrando nel merito della tua demo e della ComboBox, ed eseguendo in progressione le seguenti scelte di numeri ottengo il seguente risultato:

Scelgo il n.4 e lampeggia.

Scelgo il n.5, pur restando lo sfondo rosso, non lampeggia più, mentre, se scelgo ad esempio il n.10 e poi ritorno sul n.5 allora comincia a lampeggiare.

Scelgo il n.6 e lampeggia.

Scelgo il n.7, pur restando lo sfondo verde, non lampeggia più, mentre, se scelgo ad esempio il n.2 e poi ritorno sul n.7 allora comincia a lampeggiare.

In definitiva ho capito che solo ritornando sullo sfondo grigio, delle volte anche per due volte consecutive, oppure alternando i numeri da cui si ottengono i due colori di sfondo, riesco ad ottenere poi la cella lampeggiante sia nel rosso che nel verde.

A questo punto credo che solo tu puoi riuscire a capirne il motivo.

Se poi non si riesce a fare nulla, pazienza... già è tanto per me quello che sei riuscito ad ottenere.

Credo che il tuo problema sia legato ad un problema di temporizzazione: quando si verifica un problema, il codice viene avviato prima che l'operazione precedente sia terminata. 

Pertanto, prova qualcosa del genere:

Nel modulo di codice del foglio di interesse, sostituisci il codice con la seguente versione:

'========>>

Option Explicit

'-------->>

Private Sub ComboBox1_Change()

    Const sDestRng As String = "C7:F7"

    Set destRng = Me.Range(sDestRng)

    Me.ComboBox1.LinkedCell = "C3"

    Select Case Me.ComboBox1.Value

        Case Is <= 3

            destRng.Interior.Color = 14277081

            myColor = 14277081

            Exit Sub

        Case Is >= 6

            destRng.Interior.Color = 5287936

            myColor = 5287936

        Case Else

            destRng.Interior.Color = 255

            myColor = 255

    End Select

    With ActiveSheet.ComboBox1

        .Enabled = False

        .Visible = False

    End With

    Call StartIt

End Sub

'<<========

Nel modulo di codice standard,, sostituisci il codice esistenti con:

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

Option Explicit

Public RunWhen As Double

Public RunWhen2 As Double

Public Const cRunIntervalSeconds = 1

Public Const cRunWhat = "Blink"

Public Const cRunWhat2 = "StopIt"

Public Const dColor As Double = 255

Public Const dColor2 As Double = 5287936

Public Const sFormula As String = "=AND($F$3>3,$F$3<6)"

Public Const sFormula2 As String = "=$F$3>=6"

Public srcRng As Range

Public destRng As Range

Public myColor As Double

Public theColor As Double

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

Public Sub Blink()

    destRng.Interior.Color = theColor

    Call StartIt

End Sub

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

Public Sub StartIt()

    With ActiveSheet.ComboBox1

        .Enabled = False

        .Visible = False

    End With

    theColor = IIf(theColor = myColor, -4142, myColor)

    RunWhen = Now + TimeSerial(0, 0, 1)

    RunWhen2 = Now + TimeSerial(0, 0, 6)

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=True

    Application.OnTime EarliestTime:=RunWhen2, _

                       Procedure:=cRunWhat2, _

                       Schedule:=True

    On Error GoTo 0

End Sub

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

Public Sub StopIt()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

    Application.OnTime EarliestTime:=RunWhen2, _

                       Procedure:=cRunWhat2, _

                       Schedule:=False

    Call SetColor

    destRng.Interior.Color = myColor

    On Error Resume Next

    Application.OnTime EarliestTime:=Now + TimeSerial(0, 0, 3), _

                       Procedure:="ShowCombo", _

                       Schedule:=True

End Sub

'-------->>

Public Sub ShowCombo()

   With ActiveSheet.ComboBox1

        .Enabled = True

        .Visible = True

   End With

End Sub

'-------->>

Public Sub SetColor()

    Select Case srcRng.Value

        Case Is <= 3

            destRng.Interior.Color = 14277081

        Case Is >= 6

            destRng.Interior.Color = 5287936

        Case Else

            destRng.Interior.Color = 255

    End Select

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

End Sub

'-------->>

Public Sub LinkIt()

    Dim SH As Worksheet

    Dim oleObj As OLEObject

    Const sFoglio As String = "Foglio1"

    Set SH = ThisWorkbook.Sheets(sFoglio)

    Set oleObj = SH.OLEObjects("ComboBox1")

    oleObj.LinkedCell = "C3"

End Sub

'<<========

Potresti scaricare il mio file di prova Vladimiro20201002.xlsm

===

Regards,

Norman

Answer 2

Ciao Vladimiro,

purtroppo c'è un problema.

Lo sfondo lampeggia solo se nella cella F3 inserisco manualmente i numeri.

Purtroppo non lampeggia in quanto la cella F3 si aggiorna tramite casella combinata (come in figura), o meglio:

F3 = C3

C3 è la cella che riceve i dati tramite casella combinata.

Nel modulo di codice del foglio di interesse, sostituisci il codice precedente con la seguente versione:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Calculate()

    Const sCella As String = "C3"

    Const sDestRng As String = "C7:F7"

    Set srcRng = Me.Range(sCella)

    Set destRng = Me.Range(sDestRng)

    myColor = destRng.DisplayFormat.Interior.Color

    If srcRng.Value > 3 Then

        destRng.FormatConditions(1).Delete

        destRng.FormatConditions(1).Delete

        bFlag = False

        Call StartIt

    End If

End Sub

'<<========

===

Regards,

Norman

Ciao Norman,

a funzionare funziona, solo che mi esce il seguente errore:

A dire il vero, anche con l'altro codice, quando potevo inserire i numeri manualmente, a prescindere dal primo numero che inserivo, mi dava il colore lampeggiante; successivamente però, andando ad inserire l'altro numero mi usciva lo stesso errore.

Vladimiro

Answer 3

Ciao Vladimiro,

purtroppo c'è un problema.

Lo sfondo lampeggia solo se nella cella F3 inserisco manualmente i numeri.

Purtroppo non lampeggia in quanto la cella F3 si aggiorna tramite casella combinata (come in figura), o meglio:

F3 = C3

C3 è la cella che riceve i dati tramite casella combinata.

Nel modulo di codice del foglio di interesse, sostituisci il codice precedente con la seguente versione:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Calculate()

    Const sCella As String = "C3"

    Const sDestRng As String = "C7:F7"

    Set srcRng = Me.Range(sCella)

    Set destRng = Me.Range(sDestRng)

    myColor = destRng.DisplayFormat.Interior.Color

    If srcRng.Value > 3 Then

        destRng.FormatConditions(1).Delete

        destRng.FormatConditions(1).Delete

        bFlag = False

        Call StartIt

    End If

End Sub

'<<========

===

Regards,

Norman

Answer 4

Ciao Vladimiro,

nel momento in cui una cella (o un unione celle) raggiunge dei requisiti e si colora, tramite formattazione condizionale, di un colore diverso dal grigio predefinito, ad esempio di colore rosso o di colore verde, è possibile farlo "lampeggiare", magari alternando due colori, ad esempio rosso e bianco per il rosso e verde e bianco per il verde?

Al seguente link c'è una demo contenente un piccolo esempio per agevolare chi, cortesemente, vuole darmi una mano.

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

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim dColor As Double

    Dim dVal As Double

    Const sCella As String = "F3"

    Const sDestRng As String = "C7:F7"

    Set srcRng = Intersect(Me.Range(sCella), Target)

    Set destRng = Me.Range(sDestRng)

    If Not srcRng Is Nothing Then

        myColor = destRng.DisplayFormat.Interior.Color

        If srcRng.Value > 3 Then

            destRng.FormatConditions(1).Delete

            destRng.FormatConditions(1).Delete

            bFlag = False

            Call StartIt

        End If

    End If

End Sub

'<<========

In un modulo standard, incolla:

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

Option Explicit

Public RunWhen As Double

Public RunWhen2 As Double

Public Const cRunIntervalSeconds = 1

Public Const cRunWhat = "Blink"

Public Const cRunWhat2 = "StopIt"

Public Const dColor As Double = 255

Public Const dColor2 As Double = 5287936

Public Const sFormula As String = "=AND($F$3>3,$F$3<6)"

Public Const sFormula2 As String = "=$F$3>=6"

Public srcRng As Range

Public destRng As Range

Public myColor As Double

Public theColor As Double

Public bFlag As Boolean

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

Public Sub Blink()

    destRng.Interior.Color = theColor

    Call StartIt

End Sub

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

Public Sub StartIt()

    On Error Resume Next

    theColor = IIf(theColor = myColor, -4142, myColor)

    RunWhen = Now + TimeSerial(0, 0, 1)

    RunWhen2 = Now + TimeSerial(0, 0, 10)

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                      Schedule:=True

    If bFlag Then Exit Sub

    Application.OnTime EarliestTime:=RunWhen2, _

                       Procedure:=cRunWhat2, _

                       Schedule:=True

    bFlag = True

End Sub

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

Public Sub StopIt()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

    destRng.Interior.Color = 14277081

    Call SetCondFormat

End Sub

'-------->>

Public Sub SetCondFormat()

    With destRng

       .Select

        .FormatConditions.Add Type:=xlExpression, Formula1:=sFormula

        With .FormatConditions(.FormatConditions.Count)

            .SetFirstPriority

            With .Interior

                .PatternColorIndex = xlAutomatic

                .Color = dColor

                .TintAndShade = 0

            End With

        End With

        .FormatConditions.Add Type:=xlExpression, Formula1:=sFormula2

        With .FormatConditions(.FormatConditions.Count)

            With .Interior

                .PatternColorIndex = xlAutomatic

                .Color = dColor2

                .TintAndShade = 0

            End With

        End With

        .Interior.ColorIndex = 12566463

    End With

End Sub

'<<========

Potresti scaricare il mio file di prova Vladimiro20200926.xlsm

===

Regards,

Norman

Ciao Norman,

purtroppo c'è un problema.

Lo sfondo lampeggia solo se nella cella F3 inserisco manualmente i numeri.

Purtroppo non lampeggia in quanto la cella F3 si aggiorna tramite casella combinata (come in figura), o meglio:

F3 = C3

C3 è la cella che riceve i dati tramite casella combinata.

Vladimiro

Answer 5

Ciao Vladimiro,

nel momento in cui una cella (o un unione celle) raggiunge dei requisiti e si colora, tramite formattazione condizionale, di un colore diverso dal grigio predefinito, ad esempio di colore rosso o di colore verde, è possibile farlo "lampeggiare", magari alternando due colori, ad esempio rosso e bianco per il rosso e verde e bianco per il verde?

Al seguente link c'è una demo contenente un piccolo esempio per agevolare chi, cortesemente, vuole darmi una mano.

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

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim dColor As Double

    Dim dVal As Double

    Const sCella As String = "F3"

    Const sDestRng As String = "C7:F7"

    Set srcRng = Intersect(Me.Range(sCella), Target)

    Set destRng = Me.Range(sDestRng)

    If Not srcRng Is Nothing Then

        myColor = destRng.DisplayFormat.Interior.Color

        If srcRng.Value > 3 Then

            destRng.FormatConditions(1).Delete

            destRng.FormatConditions(1).Delete

            bFlag = False

            Call StartIt

        End If

    End If

End Sub

'<<========

In un modulo standard, incolla:

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

Option Explicit

Public RunWhen As Double

Public RunWhen2 As Double

Public Const cRunIntervalSeconds = 1

Public Const cRunWhat = "Blink"

Public Const cRunWhat2 = "StopIt"

Public Const dColor As Double = 255

Public Const dColor2 As Double = 5287936

Public Const sFormula As String = "=AND($F$3>3,$F$3<6)"

Public Const sFormula2 As String = "=$F$3>=6"

Public srcRng As Range

Public destRng As Range

Public myColor As Double

Public theColor As Double

Public bFlag As Boolean

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

Public Sub Blink()

    destRng.Interior.Color = theColor

    Call StartIt

End Sub

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

Public Sub StartIt()

    On Error Resume Next

    theColor = IIf(theColor = myColor, -4142, myColor)

    RunWhen = Now + TimeSerial(0, 0, 1)

    RunWhen2 = Now + TimeSerial(0, 0, 10)

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                      Schedule:=True

    If bFlag Then Exit Sub

    Application.OnTime EarliestTime:=RunWhen2, _

                       Procedure:=cRunWhat2, _

                       Schedule:=True

    bFlag = True

End Sub

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

Public Sub StopIt()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

    destRng.Interior.Color = 14277081

    Call SetCondFormat

End Sub

'-------->>

Public Sub SetCondFormat()

    With destRng

       .Select

        .FormatConditions.Add Type:=xlExpression, Formula1:=sFormula

        With .FormatConditions(.FormatConditions.Count)

            .SetFirstPriority

            With .Interior

                .PatternColorIndex = xlAutomatic

                .Color = dColor

                .TintAndShade = 0

            End With

        End With

        .FormatConditions.Add Type:=xlExpression, Formula1:=sFormula2

        With .FormatConditions(.FormatConditions.Count)

            With .Interior

                .PatternColorIndex = xlAutomatic

                .Color = dColor2

                .TintAndShade = 0

            End With

        End With

        .Interior.ColorIndex = 12566463

    End With

End Sub

'<<========

Potresti scaricare il mio file di prova Vladimiro20200926.xlsm

===

Regards,

Norman