Pulsante che colori lo sfondo di determinate celle.

Question

Qualcuno mi saprebbe fornire un codice VBA per un Pulsante che al suo click mi colori solo lo sfondo di azzurro ( 0-176-240 ) le celle contenenti i seguenti numeri : 1-6-13-15-18-22-25 se li trova .

Il pulsante dovrebbe avere 2 funzioni , con un click , colora di azzurro e al 2° click toglie l'azzurro e lascia tutto come era prima.

Non posso usare 2 pulsanti , uno per inserire e l'altro per escludere perché ho problemi di spazio.

Grazie.

Answer 1

Ciao Lupetto,

Ciao Norman

Ho riscontrato due problemini , premesso che ho un colorazione di fondo sul foglio , colore grigio RGB 128-128-128 , vedo una interferenza nei righi 16-22-28-34-40-46 ecc. mi va a scoprire delle celle , e la stessa cosa mi fa sull'azzurro , quando disattivo il pulsante non torna grigio ma lo lasscia bianco.

Potresti notare che non hai rivelato al forum il fatto che stavi usando uno sfondo grigio e quindi il mio codice non ha tenuto conto di questo 😊

Fortunatamente, la modifica richiesta del codice è semplice e breve:

'========>>

Option Explicit

'-------->>

Public Sub Colora_Celle()

Dim arrValori As Variant 

Dim Rng As Range, rCell As Range, srcRow As Range 

Dim Res As Variant 

Dim i As Long 

Const sColonne As String = "D:AD"                       '<<=== Modifica 

Const iFirstRow As Long = 12                                '<<=== Modifica 

Const iLastRow As Long = 104                               '<<=== Modifica 

arrValori = VBA.Array(1, 6, 13, 15, 18, 22, 25) 

For i = iFirstRow To iLastRow Step 6 

  With ActiveSheet 

  Set srcRow = Intersect(.Rows(i), Columns(sColonne)) 

  End With 

    For Each rCell In srcRow.Cells 

        With rCell 

            Res = Application.Match(.Value, arrValori, 0) 

            With .Offset(2) 

                If Not IsError(Res) Then 

                    If .Interior.Color = RGB(0, 176, 240) Then 

                        .Interior.Color = **RGB(128, 128, 128)** 

                    Else 

                        .Interior.Color = RGB(0, 176, 240) 

                    End If 

                Else 

                    .Offset(2).Interior.Color = **RGB(128, 128, 128)** 

                End If 

            End With 

        End With 

    Next rCell 

Next i 

End Sub

'<<========

Ho aggiornato il mio file di prova Lupetto20230608.xlsm **** di conseguenza.

===

Regards,

Norman

Answer 2

Ciao Norman

In tutti e due i casi non va bene perché in quelle celle del range D12:AD12 arrivano in continuazione dati nuovi ed hanno bisogno della formattazione , a tal proposito opterei per un'altra strada per evidenziare quella serie di numeri al mio click sul pulsante ON / OFF: 1-6-13-15-18-22-25 se li trova , vale a dire : mi va semplicemente a colorare di azzurro le celle sottostanti del rigo D14:AD14 perché sono celle libere.

I righi di interesse dove arrivano i numeri sono i seguenti : 12-18-24-30-36-42-48-54-60-66-72-78-84-90-96-102

I righi da colorare di azzurro sono i seguenti : 14-20-26-32-38-44-50-56-62-68-74-80-86-92-98-104

Grazie per la gentile collaborazione.

Answer 3

Ciao Lupetto,

Se tu volessi cancellare la formattazione condizionale, potresti provare la seguente modifica del mio codice:

'========>>

Option Explicit

'-------->>

Public Sub Colora_celle()

Dim arrValori As Variant, arrRed As Variant, arrBlack As Variant 

Dim Rng As Range, rCell As Range 

Dim Res As Variant, Res2 As Variant, Res3 As Variant 

Const sIntervallo As String = "**D12:Z12**"                                        **'<<=== Modifica** 

arrValori = VBA.Array(**1, 6, 13, 15, 18, 22, 25**) 

arrRed = VBA.Array(**1, 3, 5, 7, 9, 12, 14, 16, 18, 19, 21, 23, 25, 27, 30, 32, 34, 36**) 

arrBlack = VBA.Array(**2, 4, 6, 8, 10, 11, 13, 15, 17, 20, 22, 24, 26, 28, 29, 31, 33, 35**) 

Set Rng = ActiveSheet.Range(sIntervallo) 

For Each rCell In Rng.Cells 

    With rCell 

        Res = Application.Match(.Value, arrValori, 0) 

        Res2 = Application.Match(.Value, arrRed, 0) 

        Res3 = Application.Match(.Value, arrBlack, 0) 

        Select Case True 

            Case IsEmpty(.Value) 

                .Interior.ColorIndex = xlNone 

            Case .Value = 0 

                .Interior.Color = vbGreen 

            Case Not IsError(Res2) 

                If Not IsError(Res) Then 

                    If .Interior.Color <> RGB(0, 176, 240) Then 

                        .Interior.Color = RGB(0, 176, 240) 

                    Else 

                        .Interior.Color = vbRed 

                    End If 

                Else 

                    .Interior.Color = vbRed 

                End If 

            Case Not IsError(Res3) 

                If Not IsError(Res) Then 

                    If .Interior.Color <> RGB(0, 176, 240) Then 

                        .Interior.Color = RGB(0, 176, 240) 

                    Else 

                        .Interior.Color = vbBlack 

                    End If 

                Else 

                    .Interior.Color = vbBlack 

                End If 

            Case IsError(Res3) 

                .Interior.Color = vbBlack 

        End Select 

    End With 

Next rCell 

End Sub

'<<========

Questo codice colorerà di blu le celle di interesse se non lo sono già; altrimenti rimuoverà il riempimento blu e applicherà un riempimento rosso per i numeri rossi della roulette e un riempimento nero per i numeri neri della roulette.

In altre parole, questo codice colora tutte le celle nell'intervallo di interesse allo stesso modo della formattazione condizionale esistente ma, per le celle con i valori specificati, sostituirà i colori standard della roulette con il blu; se il codice incontra tali celle blu, ripristinerà i colori standard della roulette per queste celle.

Con questo codice, premendo il pulsante per la prima volta, ottengo qualcosa del genere:

Premendo il pulsante una seconda volta ottengo:

===

Regards,

Norman

Answer 4

Ciao Lupetto,

Qualcuno mi saprebbe fornire un codice VBA per un Pulsante che al suo click mi colori solo lo sfondo di azzurro ( 0-176-240 ) le celle contenenti i seguenti numeri : 1-6-13-15-18-22-25 se li trova .

Il pulsante dovrebbe avere 2 funzioni , con un click , colora di azzurro e al 2° click toglie l'azzurro e lascia tutto come era prima.

Non posso usare 2 pulsanti , uno per inserire e l'altro per escludere perché ho problemi di spazio.

Se, come sospetto, le celle di interesse sono colorate di rosso o nero come risultato della formattazione condizionale, sarebbe necessario rimuovere la formattazione condizionale perché non è possibile utilizzare un riempimento di colore normale sulle celle che sono colorate da condizionale formattazione.

Quindi, se il mio sospetto è corretto, dovrai spiegare cosa dovrebbe succedere alla formattazione condizionale dell'intervallo di interesse.

Se, tuttavia, non è presente alcuna formattazione condizionale nell'intervallo di interesse, il seguente codice potrebbe essere assegnato al tuo pulsante:

'========>>

Option Explicit

'-------->>

Public Sub Colora_celle()

Dim arrValori As Variant 

Dim Rng As Range, rCell As Range 

Dim Res As Variant 

Const sIntervallo As String = **"D12:Z12"                           '<<=== Modifica** 

arrValori = VBA.Array(**1, 6, 13, 15, 18, 22, 25**) 

Set Rng = ActiveSheet.Range(sIntervallo) 

For Each rCell In Rng.Cells 

    With rCell 

        Res = Application.Match(.Value, arrValori, 0) 

        If Not IsError(Res) Then 

            If .Interior.Color = RGB(0, 176, 240) Then 

                .Interior.ColorIndex = xlNone 

            Else 

                .Interior.Color = RGB(0, 176, 240) 

            End If 

        End If 

    End With 

Next rCell 

End Sub

'<<========

Questo codice colorerà di blu le celle di interesse se non lo sono già; altrimenti rimuoverà il riempimento blu.

===

Regards,

Norman