[Macro office] Controllare formato cella ed impostare valore

[Guybrush Threepwood]

Non so se il thread sia più giusto metterlo qui o in programmazione...ma tant'è....

Veniamo al dunque: ho bisogno di creare una macro che mi controlli il contenuto di una cella e a seconda del colore con cui è formattato il testo mi imposti il contenuto di un'altra cella.

Faccio un esempio:

la cella A1 può avere un numero formattato o in verde o in rosso. Se nella cella il numero è verde mi deve inserire nella cella A2 il valore "OK", altrimenti "KO".

Io avevo pensato banalmente a qualcosa del genere:

Range("A1").Select
If Selection.Font.ColorIndex = 4 Then
Range("A2").Select
ActiveCell.FormulaR1C1 = "OK"
Else
Range("A2").Select
ActiveCell.FormulaR1C1 = "KO"
End If

Il problema è questo: con le celle normali funziona, ma se la cella ha una formattazione condizionale la macro riconosce solo la prima condizione.

Provo a spiegarmi con un esempio:

se la formattazione condizionale della cella è:

CONDIZIONE 1: se il valore è compreso tra 4 e 8 allora il testo è verde

CONDIZIONE 2: se il valore è <4 o >8 allora il testo è rosso.

Utilizzando la macro (dove in ColorIndex ho messo il numero corrispondente al verde che ora non ricordo) mi dà sempre OK, sia che il numero nella cella sia formattato in rosso o in verde. in pratica riconosce solo la prima condizione. Infatti se per ColorIndex metto invece un altro numero mi dà sempre KO, anche se invece il numero è formattato in verde.

Sperando di non essere stato troppo contorto qualcuno mi può aiutare a risolvere?

Grazie :D

[Guybrush Threepwood]

Nulla? :(

[MarcoGG]

Le cose stanno un po' diversamente :
Anzitutto il tuo codice è corretto, infatti in mancanza di formattazione condizionale ( d'ora in poi FC ) funziona. In presenza di FC tu dici che entra solo nella prima ipotesi, ma non è così.
In realtà vede tutta la routine, ma il colore che legge non è quello "mascherato" dalla FC, ma quello reale impostato per quella cella.
Una cosa è chiedere a VBA di leggere ( o impostare ) il colore del testo di una cella, una cosa è chiedere ad Excel di farlo "apparire" del colore desiderato, con la FC. Sono 2 cose diverse.
Prova a fare un pulsante che legge solo il colore del testo-cella :
MsgBox CStr(Range("A1").Font.ColorIndex)
Noterai che se imposti manualmente il colore del testo ( da Barra Formattazione / Colore Carattere ), VBA ti ritorna sempre il colore impostato e mai quello risultante dalla FC.

Io personalmente preferisco "scrivere", quando voglio pieno controllo su qualcosa. La FC non la uso mai ( e dopo questa ulteriore prova, ho un motivo in + per farne a meno :D ). Il mio consiglio è di "Crearti la tua FC"... ;)

In soldoni :
Metti questo codice in "Foglio1" ( nell'editor VBA ) :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range
For Each R In Sheets("Foglio1").Range("A1:J1")
If R.Value < 4 Or R.Value > 8 Then
R.Font.ColorIndex = 3 'ROSSO
Else
R.Font.ColorIndex = 4 'VERDE
End If
Next R
End Sub

Questo, nell'ipotesi tu voglia condizionare il colore nell'intervallo [A1:J1] ( funziona anche se se usi un intervallo con 1 cella sola [A1] ).
Il codice è ridotto all'osso ( bisognerebbe intercettare i valori non-numerici ecc... ).

A questo punto puoi usare correttamente il tuo codice che scrive OK / KO da commandButton... ;)

[Guybrush Threepwood]

Gentilissimo :)

Solo una domanda: qual è il codice da utilizzare per creare un pulsante che annulla l'ultimo codice eseguito?

[MarcoGG]

Gentilissimo :)

Solo una domanda: qual è il codice da utilizzare per creare un pulsante che annulla l'ultimo codice eseguito?


Cioè, vorresti una "Macro-Undo-Macro_Precedente" ?
Beh, se esiste questa possibilità probabilmente funzionerà solo per Macro molto semplici ( l'Undo di Excel permette di annullare una semplice operazione per volta... ).
E' una bella domanda, ma mi riservo di provare, appena ho tempo... ;)

[Guybrush Threepwood]

Cioè, vorresti una "Macro-Undo-Macro_Precedente" ?
Beh, se esiste questa possibilità probabilmente funzionerà solo per Macro molto semplici ( l'Undo di Excel permette di annullare una semplice operazione per volta... ).
E' una bella domanda, ma mi riservo di provare, appena ho tempo... ;)

Esatto, anche perchè l'undo di excel non mi fa annullare un codice VBA

[MarcoGG]

In effetti anche in questo caso l'interfaccia di Excel sembra fare a pugni col buon vecchio VBA... Mi hai messo una bella pulce nell'orecchio e... credo di essermela tolta ! :D
In pratica quando si esegue una macro customizzata, l'elenco degli Undo disponibili viene resettato. Ad ogni modo posto una possibile e interessante soluzione che permette di aggirare il problema :

Nell'esempio che ho fatto, basta avere una tabella [A1:E5] su "Foglio1" in cui inserire valori a piacere.
Sempre su "Foglio1" metto 2 commandButton :
- cmd_reset : lancia il codiceVBA-esempio, i cui effetti poi verranno annullati dall'Undo.
- cmd_undo : routine VBA in grado di annullare gli effetti dell'ultima macro eseguita ( in questo caso, appunto il "Reset" della tabella [A1:E5] ).

- Codice da far eseguire al click di cmd_reset :
Private Sub cmd_reset_Click()
TABRESET
End Sub
- Codice da far eseguire al click di cmd_undo :
Private Sub cmd_undo_Click()
UNDO_VBA
End Sub

E qui il codice, da inserire in un modulo VBA, che serve per eseguire prima il Reset e poi l'Undo :
Type Cella
Indirizzo As String
Valore As Variant
End Type
Public WBookPrec As Workbook
Public SheetPrec As Worksheet
Public ArrayCelleSelez() As Cella

Public Sub TABRESET()
'Scrive "X" in tutte le celle della selezione :
Sheets("Foglio1").Range("A1:E5").Select
Application.ScreenUpdating = False

'*** :
ReDim ArrayCelleSelez(Selection.Count)
Set WBookPrec = ActiveWorkbook
Set SheetPrec = ActiveSheet
Dim i As Long
i = 0
For Each cell In Selection
i = i + 1
ArrayCelleSelez(i).Indirizzo = cell.Address
ArrayCelleSelez(i).Valore = cell.Formula
Next cell
'Qui il Codice VBA Annullabile:
Selection.Value = "X"
Sheets("Foglio1").Range("A1").Select

'*** :
Application.OnUndo "Undo VBA", "UNDO_VBA"
End Sub

Public Sub UNDO_VBA()
Application.ScreenUpdating = False
On Error GoTo ERRORE
WBookPrec.Activate
SheetPrec.Activate
'Ripristina dati (UNDO) :
Dim i As Long
For i = 1 To UBound(ArrayCelleSelez)
Range(ArrayCelleSelez(i).Indirizzo).Formula = ArrayCelleSelez(i).Valore
Next i
Exit Sub
ERRORE:
MsgBox "Impossibile Annullare.", vbCritical, "Errore"
End Sub

Le porzioni di codice che ho contrassegnato [***] devono essere inserite in qualsiasi routine di cui vogliamo poter annullare gli effetti, rispettando le posizioni rispetto al codice vero e proprio della routine ( quello che "fa il danno" :D ).
Bene, penso sia tutto. Prova... ;)

[Guybrush Threepwood]

Troppo gentile! :D

Leggo solo ora la risposta perchè durante la settimana sono fuori al lavoro e dall'ufficio non posso collegarmi a siti esterni e quindi ho qualche difficoltà a navigare. Appena trovo un po' di tempo durante questo fine settimana sperimento il tuo metodo.

Nel frattempo ne approfitto per fare un'altra domandina.... :D

devo creare un codice che mi controlli p.e. le celle L54 L55 L56 e se una sola di queste celle ha il numero formattato in rosso deve mettermi nella cella L72 il valore KO, altrimenti un OK dopodichè deve passare ad analizzare le celle M54 M55 e M56 e con lo stesso criterio impostare la cella M72. Quindi passare a N54 N55 e N56 e così via.

Mi viene spontaneo utilizzare un ciclo IF innestato in un ciclo FOR ma mi incarto con i contatori... :stordita: Una mano? :D

[Guybrush Threepwood]

Chiedo l'aiuto del pubblico :(

[MarcoGG]

Chiedo l'aiuto del pubblico :(


Pubblico ? :D

Credo di aver risolto il tuo -spero- ultimo quesito :D , in modo anche abbastanza elegante :

Fai attenzione ai testi in neretto perchè andranno sostituiti con quelli reali desiderati ( questa routine cmq funziona su ogni tabella, a patto che l'indice max di colonna utilizzata sia lo Z ).
Restando sul tuo esempio il codice è :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range
Dim NomiColAZ As String
NomiColAZ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
For Each R In Sheets("Foglio1").Range("L54:N56")
If R.Row = 54 Then Range(Mid(NomiColAZ, R.Column, 1) & 72).FormulaR1C1 = "OK"
If R.Font.ColorIndex = 3 Then 'SE ROSSO...
Range(Mid(NomiColAZ, R.Column, 1) & 72).FormulaR1C1 = "KO"
End If
Next R
End Sub

Sempre da inserire sotto editor VBA in "Foglio1".

:read: >> 53325

Mica male, no ? ;)

[Guybrush Threepwood]

Gentilissimo di nuovo!

Purtroppo in settimana essendo al lavoro non ho potuto leggere il post ed ho arrangiato brutalmente con questo:

For X = 9 To 256

If Cells(53, X).FormulaR1C1 = "" And Cells(54, X).FormulaR1C1 = "" And Cells(55, X).FormulaR1C1 = "" Then

Cells(73, X).Select
ActiveCell.FormulaR1C1 = ""
Cells(73, X).Interior.ColorIndex = xlNone

ElseIf Cells(53, X).Font.ColorIndex = 3 Or Cells(54, X).Font.ColorIndex = 3 Or Cells(55, X).Font.ColorIndex = 3 Then

Cells(73, X).Select
ActiveCell.FormulaR1C1 = "KO"
Cells(73, X).Interior.ColorIndex = 3

Else

Cells(73, X).Select
ActiveCell.FormulaR1C1 = "OK"
Cells(73, X).Interior.ColorIndex = 4

End If

Next X

Cells(73, 1).Select

Il tuo codice può essere preferibile?

[MarcoGG]

Se fai ciclare le colonne dalla 9 alla 256 significa che ( almeno in Excel 2003 ) vuoi proprio usare fino all'ultima colonna disponibile... Giusto ?

In tal caso la mia routine non è più valida ( ti avevo detto infatti che poteva andare bene da A a Z... ). Ma di quante colonne hai bisogno ? :eek:

Il tuo codice mi pare vada corretto. L'ho provato così, al volo, e mi ha impastato Excel ( pare tu non abbia condizionato l'uscita dal ciclo in assenza di dati ... ).
Se vuoi, appena ho tempo posso vedere di dargli una sistemata...

[MarcoGG]

OK. :)
Dimentica pure il codice al mio post #10.

Il tuo codice mi sembra un po' troppo contorto, perciò ho preferito modificare/estendere il mio precedente. Eccolo :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim R As Range
For Each R In Range("L72:IV72")
R.FormulaR1C1 = ""
Next R
For Each R In Range("L54:IV56")
If Not R.Value = "" Then Cells(72, R.Column).FormulaR1C1 = "OK"
Next R
For Each R In Range("L54:IV56")
If Not R.Value = "" Then
If R.Font.ColorIndex = 3 Then Cells(72, R.Column).FormulaR1C1 = "KO"
End If
Next R
Application.ScreenUpdating = True
End Sub

Questo funziona su tutte le 256 colonne di Excel 2003, e se usato in Excel 2007, copre tutte le 16384 colonne ! :eek: :D

- Se esiste almeno un valore Rosso in una colonna, scrive "KO".
- Se esiste almeno un valore Nero in una colonna, e nessun Rosso, scrive "OK".
- Se non esistono valori in una colonna, scrive "" - Stringa vuota.

Al solito sostituisci dove è Rosso/Grassetto con i tuoi Range desiderati... ;)

[Guybrush Threepwood]

OK. :)
Dimentica pure il codice al mio post #10.

Il tuo codice mi sembra un po' troppo contorto, perciò ho preferito modificare/estendere il mio precedente. Eccolo :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim R As Range
For Each R In Range("L72:IV72")
R.FormulaR1C1 = ""
Next R
For Each R In Range("L54:IV56")
If Not R.Value = "" Then Cells(72, R.Column).FormulaR1C1 = "OK"
Next R
For Each R In Range("L54:IV56")
If Not R.Value = "" Then
If R.Font.ColorIndex = 3 Then Cells(72, R.Column).FormulaR1C1 = "KO"
End If
Next R
Application.ScreenUpdating = True
End Sub

Questo funziona su tutte le 256 colonne di Excel 2003, e se usato in Excel 2007, copre tutte le 16384 colonne ! :eek: :D

- Se esiste almeno un valore Rosso in una colonna, scrive "KO".
- Se esiste almeno un valore Nero in una colonna, e nessun Rosso, scrive "OK".
- Se non esistono valori in una colonna, scrive "" - Stringa vuota.

Al solito sostituisci dove è Rosso/Grassetto con i tuoi Range desiderati... ;)

Bene, in settimana sperimento il codice :D

[Guybrush Threepwood]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim R As Range
For Each R In Range("L72:IV72")
R.FormulaR1C1 = ""
Next R
For Each R In Range("L54:IV56")
If Not R.Value = "" Then Cells(72, R.Column).FormulaR1C1 = "OK"
Next R
For Each R In Range("L54:IV56")
If Not R.Value = "" Then
If R.Font.ColorIndex = 3 Then Cells(72, R.Column).FormulaR1C1 = "KO"
End If
Next R
Application.ScreenUpdating = True
End Sub


Il codice funge alla grande, ho dovuto solo apportare una modifica anche se non ho capito il perchè :confused:

Oltre ad aver aggiunto una piccola cosa per i miei scopi in rosso è evidenziata la correzione:

Application.ScreenUpdating = False
Dim R As Range
For Each R In Range("I73:IV73")
R.FormulaR1C1 = ""
Next R
For Each R In Range("I53:IV55")
If Not R.Value = "" Then
Cells(73, R.Column).FormulaR1C1 = "OK"
Cells(73, R.Column).Interior.ColorIndex = 4
End If
Next R
For Each R In Range("I53:IV55")
If Not R.Value = "" Then
If R.Font.ColorIndex = 3 Then
Cells(73, R.Column).FormulaR1C1 = "KO"
Cells(73, R.Column).Interior.ColorIndex = 3
End If
End If
Next R
Application.ScreenUpdating = True

[MarcoGG]

Cioè ti dava errore se non chiudevi con "End If" ?
Ma stai usando Excel 2003 ?

Mi dici esattamente il messaggio di errore che riporta ?

[Guybrush Threepwood]

Cioè ti dava errore se non chiudevi con "End If" ?
Ma stai usando Excel 2003 ?

Mi dici esattamente il messaggio di errore che riporta ?

Se uso il tuo codice originale non mi dava nessun errore, mentre se aggiungo la condizione di formattare lo sfondo della cella sì e ho dovuto aggiungere l'END IF

Sì, uso Excel 2003

[MarcoGG]

Ok. Certo.

Scrivere un IF / THEN su tutta una riga si può fare, a patto che l'azione da compiere se la IF è verificata, sia UNA sola.
Su due o più azioni è praticamente d'obbligo chiudere con "End If". :)

[Guybrush Threepwood]

Ok. Certo.

Scrivere un IF / THEN su tutta una riga si può fare, a patto che l'azione da compiere se la IF è verificata, sia UNA sola.
Su due o più azioni è praticamente d'obbligo chiudere con "End If". :)
[COLOR="Navy"]
In ogni caso funziona :D

Adesso devo solo sperimentare il tasto per annullare l'operazione /COLOR]