Blocco celle e colore

Ciao

Puoi provare così (codice da inserire nel Modulo del Foglio interessato)

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
  If Target = "NB" Then
    Range("D2:D37").Interior.ColorIndex = 1
  Else
    Range("D2:D37").Interior.ColorIndex = 6
  End If
End If
End Sub

Fai sapere. Ciao,

Mario

l'ho provato nel file originale e mi cancella alcune altre formattazioni... 😫 

se non ci sono altre soluzioni, comunque più tardi riprovo meglio

Ciao

Ma non avevi parlato di altre formattazioni!!!!

Precisa meglio quali sono e vediamo cosa si può fare.

Ciao,

Mario

Facciamo cosi, ti allego il file per intero, le celle da bloccare e colorare di nero sono "BM2:BM37, quella in cui mettere il carattere NB è BM1.

Ciao

Con un file "protetto" (e non voglio crackarlo 😬 ) non si può far nulla.

Comunque nel suggerimento che t'ho dato basta sostituire i riferimenti alle celle con i tuoi (BM ecc)

Ciao,

Mario

Ciao hai ragione, ho tolto la password VBA e mi sono dimenticato della psw di scrittura 😏 
allego il file sprotetto, perchè ho riprovato, ma il codice che mi hai indicato non viene applicato, ne alla variazione della data e neanche per altre variazioni nel file, anzi alla variazione di dati in zona (JG8) mi salta la formula tra F36:GE36 e F373:GE73

siccome molte formule sono state create con office 365, questi "errori" possono essere causati dal fatto che in questo momento sto usando office 2016?

ciao

non sono espertissimo

ma da quel che so

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("JG12")) Is Nothing Then
  If Target = "NB" Then
    Range("BM2:BM37").Interior.ColorIndex = 1
  Else
    Range("BM2:BM37").Interior.ColorIndex = 6
  End If
  End If
End Sub

ha un piccolo difetto

Jg12 è popolata con una formula

e If Not Intersect(Target, Range("JG12"))

non intercetta le variazioni da formula

dovresti provare con CALCULATE

mi spiace ma non va, neanche forzando la variazione manualmente in MB1

Ciao

Prova a correggere la mia macro così

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("JG8")) Is Nothing Then
  If Range("JH12") <= 28 Then
    Range("BM2:BM37").Interior.ColorIndex = 1
  ElseIf Range("JH12") = 29 Then
    Range("BM2:BM37").Interior.ColorIndex = 6
  End If
  End If
End Sub

Ciao,

Mario

Ciao Mario forse ci siamo, mi rimane solo da testare il codice su Office 365, perchè continua a saltare la formula in F36 e F73:
Ti aggiorno domani.

Se dovesse funzionare, si potrebbe aggiungere anche la protezione celle in quella colonna, in modo da inibirne la compilazione anche accidentale negli anni non bisestili?

Ciao

Prova e poi si vede. Immagino che possa farsi.

Ciao,

Mario

Buongiorno, allora come avevo sospettato, la causa degli errori sulle formule è di Office
Il codice con Office 365 funziona benissimo.
Ho anche aggiunto una modifica che colora l'unica cella colorata che mi rimaneva fuori dalle 2 casistiche.
La cella BM2 color pesca.

Ora se il range (BM2:BM37) venisse bloccato quando ("JH12") <= 28 sarebbe perfetto.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("JG8")) Is Nothing Then
If Range("JH12") <= 28 Then
Range("BM2:BM37").Interior.ColorIndex = 1
ElseIf Range("JH12") = 29 Then
Range("BM2:BM37").Interior.ColorIndex = 2
If Range("JH12") = 29 Then
Range("BM2").Interior.ColorIndex = 44
End If
End If
End If
End Sub

Ciao

La procedura (non l'ho mai provata vista la labile protezione di Excel) è questa: sproteggi il foglio, blocchi le celle e riproteggi il foglio. Qualcosa del genere:

.....

If Range("JH12") <= 28 Then
  Range("BM2:BM37").Interior.ColorIndex = 1

  ActiveSheet.Unprotect
  Range("BM2:BM37").Locked = True
  ActiveSheet.Protect

....

Ciao,

Mario

Ciao Mario, ho solo ristretto il range blocco celle nel caso bisestile, per tenere bloccate comunque le celle con le formule, ma il codice funziona tutto.

Private Sub Worksheet_Change(ByVal Target As Range) ' per colorare e bloccare giorno non bisestile
  If Not Intersect(Target, Range("JG8")) Is Nothing Then
  If Range("JH12") <= 28 Then
    Range("BM2:BM37").Interior.ColorIndex = 1
    ActiveSheet.Unprotect
    Range("BM2:BM37").Locked = True
    ActiveSheet.Protect
  ElseIf Range("JH12") = 29 Then
    Range("BM2:BM37").Interior.ColorIndex = 2
  If Range("JH12") = 29 Then
    Range("BM2").Interior.ColorIndex = 44
    ActiveSheet.Unprotect
    Range("BM6:BM35").Locked = False
    ActiveSheet.Protect
  End If
  End If
  End If
End Sub