Sblocco/blocco password nel codice VBA mi rallenta l'aggiornamento dei dati.

Question

Ciao,

volendo continuare con il seguente thread inserendo lo sblocco/blocco della password nel suddetto codice:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sPassword As String

Dim i As Integer

    sPassword = "MiaPassword"

ActiveSheet.Unprotect Password:=sPassword

'Controlliamo che la cella modificata sia proprio B7 utilizzando un trucco di vba,

'controlliamo che l'intersezione dei range non sia nulla, ovvero, come per gli insiemi

'che il "target" sia compreso nel Range in cui lo cerchiamo

'usando la negazione IF NOT IS NOTHING evitiamo di incorrere in un accesso ad un valore nullo e quindi ad un errore

If Not Intersect(Range("B7"), Target) Is Nothing Then

    'Controlliamo che in B7 ci sia effettivamente un valore numerico

    If IsNumeric(Range("B7")) And Not IsEmpty(Range("B7")) Then

        'Iteriamo per 9 volte e utilizziamo la variabile di iterazione "i" sia come riferimento

        'all'offset della riga in cui scriveremo, sia per aggiungere al valore di B7 proprio i

        For i = 1 To 9

            'scriviamo in "offset" righe rispetto a b7 il valore che c'e' in B7 + i

            Range("B7").Offset(i) = Range("B7") + i

        Next i

    End If

End If

    ActiveSheet.Protect Password:=sPassword

End Sub

ho un vistoso rallentamento nello sviluppo dei dati.

C'è un sistema migliore per sbloccare la password?

Vladimiro

Answer 1

Buonasera Vladimiro,

Partendo dal presupposto che non ha tanto senso "rimuovere" e "rimettere" la protezione ad un foglio ad ogni "Change", considererei l'opzioni di creare un pulsante con una macro che ti tolga e rimetta la protezione.

Il problema qui sta nel fatto che l'evento change viene richiamato in modo ricorsivo e quindi "toglie e rimette" la protezione di continuo, inoltre viene chiamato anche inutilmente, perché se la cella non e' B7 non ha senso togliere e rimettere la protezione come hai scritto nel codice, in quanto l'evento change viene chiamato solo da celle che sono cambiabili e quindi non protette, presuppongo che nel tuo foglio sia proprio la cella B7 una di esse.

Inoltre puoi disattivare il refresh dello schermo e i calcoli fino ad operazione completata per velocizzare maggiormente

Questa e' la correzione che puoi apportare:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sPassword As String
Dim i As Integer
    
'Controlliamo che la cella modificata sia proprio B7 utilizzando un trucco di vba,
'controlliamo che l'intersezione dei range non sia nulla, ovvero, come per gli insiemi
'che il "target" sia compreso nel Range in cui lo cerchiamo
'usando la negazione IF NOT IS NOTHING evitiamo di incorrere in un accesso ad un valore nullo e quindi ad un errore
If Not Intersect(Range("B7"), Target) Is Nothing Then
    'Controlliamo che in B7 ci sia effettivamente un valore numerico
    If IsNumeric(Range("B7")) And Not IsEmpty(Range("B7")) Then
        sPassword = "MiaPassword"
        ActiveSheet.Unprotect Password:=sPassword
        
        'Disabilitiamo aggiornamento dello schermo e calcoli per velocizzare la procedura e Disabilitiamo gli eventi per evitare che venga richiamato in modo ricorsivo l'evento change
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        
        'Iteriamo per 9 volte e utilizziamo la variabile di iterazione "i" sia come riferimento
        'all'offset della riga in cui scriveremo, sia per aggiungere al valore di B7 proprio i
        For i = 1 To 9
            'scriviamo in "offset" righe rispetto a b7 il valore che c'e' in B7 + i
            Range("B7").Offset(i) = Range("B7") + i
        Next i
        
        'Riabilitiamo gli eventi, il refresh dello schermo e i calcoli
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        ActiveSheet.Protect Password:=sPassword
    End If
End If
    
End Sub

Saluti,

Daniele

Answer 2

Non capisco perché controlli che B16 sia diverso da vuoto e perché fai quei calcoli B* = b10-2 ?

Se quello che hai descritto e' esattamente quello che vuoi fare devi per l'appunto, "alla fine della routine" e pertanto all'uscita dal ciclo For,semplicemente moltiplicare il numero per meno uno.

Range("B7") = Range("B7") * -1

ovvero:

For i = 1 To 9
    'scriviamo in "offset" righe rispetto a b7 il valore che c'e' in B7 + i
    Range("B7").Offset(i) = Range("B7") + i
Next i
Range("B7") = Range("B7") * -1

Ciao Daniele,

ieri prima della tua risposta in cui mi consigliavi:

'Disabilitiamo aggiornamento dello schermo e calcoli per velocizzare la procedura e

'Disabilitiamo gli eventi per evitare che venga richiamato in modo ricorsivo l'evento change

Application.EnableEvents = False

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

pur inserendo:

Range("B7") = -Range("B7")

che poi è la stessa cosa di Range("B7") = Range("B7") * -1

non mi rilasciava i valori esatti, per cui mi sono inventato quel codice strano ma funzionante.

Adesso sono più tranquillo.

Grazie mille,

Vladimiro

Answer 3

Non capisco perché controlli che B16 sia diverso da vuoto e perché fai quei calcoli B* = b10-2 ?

Se quello che hai descritto e' esattamente quello che vuoi fare devi per l'appunto, "alla fine della routine" e pertanto all'uscita dal ciclo For,semplicemente moltiplicare il numero per meno uno.

Range("B7") = Range("B7") * -1

ovvero:

For i = 1 To 9
    'scriviamo in "offset" righe rispetto a b7 il valore che c'e' in B7 + i
    Range("B7").Offset(i) = Range("B7") + i
Next i
Range("B7") = Range("B7") * -1

Answer 4

Buonasera Vladimiro,

Partendo dal presupposto che non ha tanto senso "rimuovere" e "rimettere" la protezione ad un foglio ad ogni "Change", considererei l'opzioni di creare un pulsante con una macro che ti tolga e rimetta la protezione.

Ciao Daniele,

a prescindere dall'esempio, ci sono programmi più complessi in cui bisogna avere delle celle con formule sempre protette in modo che, seppur involontariamente, non possono essere cancellate.

Il problema qui sta nel fatto che l'evento change viene richiamato in modo ricorsivo e quindi "toglie e rimette" la protezione di continuo, inoltre viene chiamato anche inutilmente, perché se la cella non e' B7 non ha senso togliere e rimettere la protezione come hai scritto nel codice, in quanto l'evento change viene chiamato solo da celle che sono cambiabili e quindi non protette, presuppongo che nel tuo foglio sia proprio la cella B7 una di esse. 

Come già scritto, cercavo un modo diverso per inserire la password proprio per evitare l'evento ricorsivo.

Inoltre puoi disattivare il refresh dello schermo e i calcoli fino ad operazione completata per velocizzare maggiormente 

Questa e' la correzione che puoi apportare: 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sPassword As String
Dim i As Integer
    
'Controlliamo che la cella modificata sia proprio B7 utilizzando un trucco di vba,
'controlliamo che l'intersezione dei range non sia nulla, ovvero, come per gli insiemi
'che il "target" sia compreso nel Range in cui lo cerchiamo
'usando la negazione IF NOT IS NOTHING evitiamo di incorrere in un accesso ad un valore nullo e quindi ad un errore
If Not Intersect(Range("B7"), Target) Is Nothing Then
    'Controlliamo che in B7 ci sia effettivamente un valore numerico
    If IsNumeric(Range("B7")) And Not IsEmpty(Range("B7")) Then
        sPassword = "MiaPassword"
        ActiveSheet.Unprotect Password:=sPassword
        
        'Disabilitiamo aggiornamento dello schermo e calcoli per velocizzare la procedura e Disabilitiamo gli eventi per evitare che venga richiamato in modo ricorsivo l'evento change
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        
        'Iteriamo per 9 volte e utilizziamo la variabile di iterazione "i" sia come riferimento
        'all'offset della riga in cui scriveremo, sia per aggiungere al valore di B7 proprio i
        For i = 1 To 9
            'scriviamo in "offset" righe rispetto a b7 il valore che c'e' in B7 + i
            Range("B7").Offset(i) = Range("B7") + i
        Next i
        
        'Riabilitiamo gli eventi, il refresh dello schermo e i calcoli
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        ActiveSheet.Protect Password:=sPassword
    End If
End If
    
End Sub

Saluti, 

Daniele

Adesso va molto meglio, se non ci sono altre soluzioni adotterò sempre questo sistema.

Approfitto per chiederti un'altra cosa.

Siccome ho bisogno alla fine dello sviluppo della routine di inserire in B7 lo stesso valore con il segno meno, dopo vari tentativi ho trovato questo sistema, anche se funzionante, per la verità non troppo performante :-)

...

For i = 1 To 9

            'scriviamo in "offset" righe rispetto a b7 il valore che c'e' in B7 + i

            Range("B7").Offset(i) = Range("B7") + i

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

                Range("B7") = -Range("B9") + 2

                Range("B8") = Range("B10") - 2

                Exit For

            End If

        Next i

...

che ne pensi?

Vladimiro