Bloccare cella tramite macro.

Question

Ciao,

ho notato che l'argomento in oggetto è stato già trattato diverse volte, però non sono riuscito a trovare una soluzione.

Quello che mi serve è una semplice cosa e cioè:

se la cella H3 è vuota si può inserire un valore, altrimenti no.

Ho provato in questo modo:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Range("H3") <> "" Then

    Range("H3").Locked = True

Else

    Range("H3").Locked = False

End If

End Sub

ma mi esce il seguente errore:

Vladimiro

Answer 1

Ciao Vladimiro,

il link è sempre lo stesso, solo che la demo l'ho modificata inserendo i tuoi suggerimenti.

Allora il problema è il seguente:

se inserisco manualmente un valore nella cella H3 e successivamente provo a modificarlo, non me lo fa fare e dunque funziona bene.

Se invece comincio ad inserire i valori tramite i pulsanti VINTA o PERSA e provo a modificarli manualmente, me lo fa fare e questo non va bene.

Riassumendo:

vorrei bloccare la cella H3 al secondo inserimento a prescindere se il primo inserimento è avvenuto manualmente o tramite i suddetti pulsanti.

Vladimiro

Nelle tue procedure Rettangolo1A_Click e Rettangolo3A_Click, sostituisci:

   End Sub

con:

    ActiveSheet.Range(miaCella).MergeArea.Locked = True

End Sub

===

Regards,

Norman

Answer 2

Ciao Vladimiro,

esce ugualmente lo stesso errore.

Al seguente link ho messo una demo; basta inserire un valore nella cella H3 per visualizzare l'errore.

Qui si vede il grande vantaggio di un file di esempio :-)

Il tuo problema è dovuto a due fattori:

• non è possibile bloccare una cella su un foglio protetto
• non è possibile bloccare una singola cella che fa parte di un'area di cella unita

Quindi prova:

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

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)    

    Const miaCella As String = "H3"                                   '<<=== Modifica

    Const sPassword As String = "MiaPassword"                '<<=== Modifica

    With Me

        If Not Intersect(.Range(miaCella), Target) Is Nothing Then

          If Not .Range(miaCella).Value = vbNullString Then

            .Unprotect Password:=sPassword

            .Range(miaCella).MergeArea.Locked = True

            .Protect Password:=sPassword

            End If

        End If

    End With

End Sub

'<<=========

===

Regards,

Norman

Answer 3

Ciao Vladimiro,

GRANDE Norman, funziona perfettamente!!!

Per avere sempre attiva la password ed evitare l'errore, ho tolto la riga di codice ActiveSheet.Range("H3").MergeArea.Locked = True alla fine della routine e l'ho inserita (in grassetto) ad ogni opzione:

Const sPassword As String = "MiaPassword"

ActiveSheet.Unprotect Password:=sPassword

    With Application

        .EnableEvents = False

        .ScreenUpdating = False

        .Calculation = xlCalculationManual

    End With

Range("J3") = Range("J3") + 1

If Range("B4").Interior.Color = vbYellow Then

    Range("B4:B8").Interior.Color = vbWhite

    Range("B5").Interior.Color = vbYellow

    Range("H3") = Range("H3") - Range("C4")

    ActiveSheet.Range("H3").MergeArea.Locked = True

ElseIf Range("B5").Interior.Color = vbYellow Then

    Range("B4:B8").Interior.Color = vbWhite

    Range("B6").Interior.Color = vbYellow

    Range("H3") = Range("H3") - Range("C5")

    ActiveSheet.Range("H3").MergeArea.Locked = True

ElseIf Range("B6").Interior.Color = vbYellow Then

    Range("B4:B8").Interior.Color = vbWhite

    Range("B7").Interior.Color = vbYellow

    Range("H7") = Range("H7") + Range("D6")

    Range("G7") = Range("H7") / 2

    Range("G8") = Range("G7")

    Range("C7") = Range("F7") - Range("G7")

    Range("C8") = Range("F8") - Range("G8")

    Range("H3") = Range("H3") - Range("C6")

    ActiveSheet.Range("H3").MergeArea.Locked = True

ElseIf Range("B7").Interior.Color = vbYellow Then

    Range("B4:B8").Interior.Color = vbWhite

    Range("B4").Interior.Color = vbYellow

    Range("H7") = Range("H7") + Range("C7")

    Range("C7") = Range("F7") - Range("G7")

    Range("C8") = Range("F8") - Range("G8")

    Range("H3") = Range("H3") - Range("C7")

    ActiveSheet.Range("H3").MergeArea.Locked = True

ElseIf Range("B8").Interior.Color = vbYellow Then

    Range("B4:B8").Interior.Color = vbWhite

    Range("B4").Interior.Color = vbYellow

    Range("H7") = Range("H7") + Range("G7")

    Range("C7") = Range("F7") - Range("G7")

    Range("C8") = Range("F8") - Range("G8")

    Range("G7") = Range("H7") / 2

    Range("G8") = Range("G7")

    Range("H3") = Range("H3") - Range("C8")

    ActiveSheet.Range("H3").MergeArea.Locked = True

Else

    Range("B4:B8").Interior.Color = vbWhite

    Range("B4").Interior.Color = vbYellow

    Range("H3") = Range("H3") - Range("C4")

    ActiveSheet.Range("H3").MergeArea.Locked = True

End If

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

        .Calculation = xlCalculationAutomatic

    End With

    ActiveSheet.Protect Password:=sPassword

stessa cosa per l'altro pulsante.

Se non ci sono obiezioni da parte tua per il modo in cui ho inserito la riga di codice, il thread si può chiudere qui.

Ti ringrazio per il cortese riscontro.

Alla prossima.

===

Regards,

Norman