Excel Vba Proteggere solo Celle contenenti Formule

Anonimo
2019-12-19T10:13:19+00:00

Buon Giorno a tutti

Vorrei proteggere solo determinate celle di un Foglio di Lavoro , utilizzo questo codice  trovato in rete e adattato , Funziona .... ma protegge tutte le Celle del Foglio ,   il codice e' questo

Dim MRng1 As Range

Dim Cell As Range

Set MRng1 = Range("G2,I2,C3:I3,G17,I17,C18:I18,G32,I32,C33:I33,G47,I47,C48:I48,G62,I62,C63:I63")

     For Each Cell In MRng1

      If Cell.Value <> "" Then

            Cell.Locked = True

      End If

    ThisWorkbook.Worksheets("GENNAIO").Protect

    Next Cell

Dove sbaglio  ???   cosa manca  ??

                   Grazie per qualsiasi suggerimento                  Claudio P

Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo
2019-12-19T10:57:12+00:00

Ciao Claudio.

Vorrei proteggere solo determinate celle di un Foglio di Lavoro , utilizzo questo codice  trovato in rete e adattato , Funziona .... ma protegge tutte le Celle del Foglio ,   il codice e' questo

Dim MRng1 As Range

Dim Cell As Range

Set MRng1 = Range("G2,I2,C3:I3,G17,I17,C18:I18,G32,I32,C33:I33,G47,I47,C48:I48,G62,I62,C63:I63")

     For Each Cell In MRng1

      If Cell.Value <> "" Then

            Cell.Locked = True

      End If

    ThisWorkbook.Worksheets("GENNAIO").Protect

    Next Cell

Dove sbaglio  ???   cosa manca  ??

Prova qualcosa del genere:

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

Option Explicit

'--------->>

Public Sub Tester()

    Dim MRng1 As Range

    Dim Cell As Range

    With ThisWorkbook.Worksheets("GENNAIO")

        Set MRng1 = _        .Range("G2,I2,C3:I3,G17,I17,C18:I18,G32,I32,C33:I33,G47,I47,C48:I48,G62,I62,C63:I63")

        .Unprotect

        .Cells.Locked = False

        For Each Cell In MRng1.Cells

            If Cell.Value <> "" Then

                Cell.Locked = True

            End If

        Next Cell

        .Protect

    End With

End Sub

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

Comunque, per prottegere solo le formule, meglio sarebbe:

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

Option Explicit

'--------->>

Public Sub Tester()

    Dim MRng1 As Range

    Dim Cell As Range

    With ThisWorkbook.Worksheets("GENNAIO")

        On Error Resume Next

        Set MRng1 = _        .Range("G2,I2,C3:I3,G17,I17,C18:I18,G32,I32,C33:I33,G47,I47,C48:I48,G62,I62,C63:I63") _

                    .SpecialCells(xlCellTypeFormulas)

        On Error GoTo 0

        If Not MRng1 Is Nothing Then

            .Unprotect

            .Cells.Locked = False

            For Each Cell In MRng1.Cells

                If Cell.Value <> "" Then

                    Cell.Locked = True

                End If

            Next Cell

        End If

        .Protect

    End With

End Sub

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

===

Regards,

Norman

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti

2 risposte aggiuntive

Ordina per: Più utili
Più utili Più recente Meno recente
  1. Anonimo
    2019-12-19T11:14:49+00:00

    Ciao Claudio,

    Buon Giorno Norman

    Grazie .... , pensa ,nell'attesa ,sono andato a cercare nei vari file del passato e ho trovato un tuo codice (2015 !) che ho adattato e funziona perfettamente !!!

    Dim wk1 As Workbook

    Dim Sh1 As Worksheet

    Set wk1 = ThisWorkbook

    Set Sh1 = wk1.Worksheets("GENNAIO")

    With Sh1

                .Unprotect Password:=""

                .Cells.Locked = False

                Set MRng1 = Nothing

                On Error Resume Next

                Set MRng1 = .Cells.Range("G2,I2,C3:I3,G17,I17,C18:I18,G32,I32,C33:I33,G47,I47,C48:I48,G62,I62,C63:I63")

                MRng1.Cells.Locked = True

                .Protect Password:="", _

                    DrawingObjects:=True, _

                    Contents:=True, _

                    Scenarios:=True

                    .EnableSelection = xlUnlockedCells

            End With

    Set Sh1 = Nothing

    SEI  GRANDE    !!!!            Grazie   Grazie        Claudio P

    Grazie a te, Claudio, per il cortese riscontro.

    Alla prossima.

    ===

    Regards,

    Norman

    La risposta è stata utile?

    0 commenti
  2. Anonimo
    2019-12-19T11:10:35+00:00

    Buon Giorno Norman

    Grazie .... , pensa ,nell'attesa ,sono andato a cercare nei vari file del passato e ho trovato un tuo codice (2015 !) che ho adattato e funziona perfettamente !!!

    Dim wk1 As Workbook

    Dim Sh1 As Worksheet

    Set wk1 = ThisWorkbook

    Set Sh1 = wk1.Worksheets("GENNAIO")

    With Sh1

                .Unprotect Password:=""

                .Cells.Locked = False

                Set MRng1 = Nothing

                On Error Resume Next

                Set MRng1 = .Cells.Range("G2,I2,C3:I3,G17,I17,C18:I18,G32,I32,C33:I33,G47,I47,C48:I48,G62,I62,C63:I63")

                MRng1.Cells.Locked = True

                .Protect Password:="", _

                    DrawingObjects:=True, _

                    Contents:=True, _

                    Scenarios:=True

                    .EnableSelection = xlUnlockedCells

            End With

    Set Sh1 = Nothing

    SEI  GRANDE    !!!!            Grazie   Grazie        Claudio P

    La risposta è stata utile?

    0 commenti