Intercettare il cambio del colore di sfondo di una cella

[ABRAMO48Partecipante ABRAMO48 Karma: 1 pt]

Buongiorno,

ho inserito questa funzione dell'utente:

Function INTERIOR_COLOR(ByVal CELLA)
    INTERIOR_COLOR = CELLA.Interior.ColorIndex
End Function

nella cella N76 inserisco la funzione:
=INTERIOR_COLOR(L76)

Nella cella L76 il colore di sfondo (Interior.color) è GIALLO e correttamente nella cella N76 compare 6.

Se cambio il colore della cella L76 da GIALLO a ROSSO mi aspetto che nella cella N76 compaia 3.

E invece no, rimane sempre 6 (il colorIndex del GIALLO). 

E non vale eseguire application.calculate, rimane sempre 6.

Ma se faccio un copia incolla nella cella N76, da un'altra cella (no la stessa N76), per esempio da quella immediatamente sotto la N77, che contiene la stessa istruzione: =INTERIOR_COLOR(L77), allora nella cella N76 compare, correttamente  3.

Perchè? 

Como posso fare per ottenere immediatamente, nella cella N76, il corretto numero del colore interno della cella L76, al cambio di colore di questa?

Grazie!

 

 

[gianfranco55Partecipante gianfranco55 Karma: 91 pts]

ciao

prova a fare F2 e invio nella cella dove hai la formula

io normalmente (quasi mai)

uso una formula e la richiamo sulla cella

esempio

nome formula 

info

formula

=INFO.CELLA(63;Foglio1!$A1)

in B1 scrivo

=info

ecco che mi rende il colore

se lo cambio

F2 su B1 e invio...............ecco aggiornato

 

in pratica devi attivare la cella con la formula

 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Non c'è un evento specifico che intercetta l'evento Change del colore interno di una cella (con l'evento SelectionChange del foglio che richiama Application.Calculate si potrebbe comunque ottenere il risultato, basterebbe spostarsi su una cella qualsiasi).

In verità googlando ho trovato qualcosa che potrebbe funzionare ma risulterebbe quasi come sparare col cannone a una mosca, e non so quanto sia utile una soluzione simile.

[ABRAMO48Partecipante ABRAMO48 Karma: 1 pt]

Grazie per l'interessamento ragazzi!

Alla fine ho risolto con una macro  che scorre le celle  estraendo l'Interior.ColorIndex.

E' un sistema indiretto, ma può andare.

La macro già mi serviva per impostare una formattazione condizionale su un Range di celle, relativa appunto al colore di sfondo in base al valore di contenuto nella cella adiacente ad ogni cella.

L'utente può scegliere il colore da associare ad ogni valore e poi reimpostare con la macro la formattazione condizionale. E' bastato inserire all'inizio un ciclo for sulla tabella dei valori con i colori associati, per estrarre l'interior.colorindex e memorizzarlo in una colonna accanto.

Certo trovavo più elegante (e mi aveva incuriosito l'idea di come fare) avere il valore del colore immediatamente al cambio di colore della cella.

Ma vedo che non è semplice come può sembrare.

Grazie! Sempre pronti ad ogni quesito!

Siete grandiiiii ....

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

vecchio frac ha scritto:

In verità googlando ho trovato qualcosa che potrebbe funzionare

Quello che ho trovato funziona, in effetti. Rallenta un po' come prevedibile (ma si può aggiustare se si imposta a priori un range determinato da controllare).

Ecco il codice:

In un modulo di classe di nome C_CellColorChange:

Option Explicit

Private WithEvents cmb As Office.CommandBars
Private bCancel As Boolean
Private bAllCellsCounted As Boolean
Private vCellCurColor() As Variant
Private vCellPrevColor() As Variant
Private sCellAddrss() As String
Private sVisbRngAddr As String
Private i As Long
Private oSh As Worksheet
Private oCell As Range

Public Sub ApplyToSheet(Sh As Worksheet)
    Set oSh = Sh
End Sub

Public Sub StartWatching()
    Set cmb = Application.CommandBars
End Sub

Private Sub Class_Initialize()
    bAllCellsCounted = False
End Sub


Private Sub cmb_OnUpdate()

    If Not ActiveSheet Is oSh Then Exit Sub
    bCancel = False
    i = -1
    
VisibleRngChanged:
    If sVisbRngAddr <> ActiveWindow.VisibleRange.Address _
        And sVisbRngAddr <> "" Then
        Erase sCellAddrss
        Erase vCellCurColor
        Erase vCellPrevColor
        sVisbRngAddr = ""
        bAllCellsCounted = False
        GoTo VisibleRngChanged
    End If
    On Error Resume Next
        For Each oCell In ActiveWindow.VisibleRange.Cells
            ReDim Preserve sCellAddrss(i + 1)
            ReDim Preserve vCellCurColor(i + 1)
            sCellAddrss(i + 1) = oCell.Address
            vCellCurColor(i + 1) = oCell.Interior.Color
            If vCellPrevColor(i + 1) <> vCellCurColor(i + 1) Then
                If bAllCellsCounted = True Then
                    oCell.Interior.Color = vCellPrevColor(i + 1)
                    CallByName oSh, _
                    "CellColorChanged", VbMethod, oCell, _
                    oCell.Interior.Color, bCancel
                    If Not bCancel Then
                        oCell.Interior.Color = vCellCurColor(i + 1)
                        vCellPrevColor(i + 1) = vCellCurColor(i + 1)
                    Else
                        oCell.Interior.Color = vCellPrevColor(i + 1)
                        vCellCurColor(i + 1) = vCellPrevColor(i + 1)
                    End If
                    bCancel = False
                End If
            End If
                i = i + 1
            If i + 1 >= ActiveWindow.VisibleRange.Cells.Count Then
                bAllCellsCounted = True
                ReDim Preserve vCellPrevColor(UBound(vCellCurColor))
                vCellPrevColor = vCellCurColor
            End If
            vCellPrevColor(i + 1) = vCellCurColor(i + 1)
        Next
    On Error GoTo 0
        sVisbRngAddr = ActiveWindow.VisibleRange.Address

End Sub

Mentre nel codice del foglio che si desidera monitorare:

Option Explicit

Private oCellColorMonitor As C_CellColorChange

Public Sub CellColorChanged(Cell As Range, Color As Variant, Cancel As Boolean)
    
    Const MSG1 As String = "Stai cambiando l'interior color del range: "
    Const MSG2 As String = "Vuoi continuare ?"
    
    If MsgBox(MSG1 & Cell.Address & vbNewLine & MSG2, vbQuestion + vbYesNo) = vbNo Then
        Cancel = True
    End If

End Sub

Sub Pulsante1_Click()
'start watching
    Set oCellColorMonitor = New C_CellColorChange
    oCellColorMonitor.ApplyToSheet ActiveSheet
    oCellColorMonitor.StartWatching
End Sub

Sub Pulsante2_Click()
'stop watching
    Set oCellColorMonitor = Nothing
End Sub

Qui ho previsto che sul foglio ci sono due pulsanti, Pulsante1 e Pulsante2, che attivano e disattivano, rispettivamente, la procedura di controllo. Niente impedisce di avviare il codice all'Open del Workbook. Tanto per provare.
Allego anche il file  per chi non ha pazienza di fare il copia incolla   

Allegati:

You must be logged in to view attached files.

[Autore]

Articoli