Problemi con Worksheet_Calculate()

Question

Buonasera,

ho il seguente codice in un foglio di lavoro che mi segnala quando cambia il valore di una cella e di conseguenza mi svolge varie azioni. Finchè ho un solo excel aperto tutto ok, ma appena ne apro un altro (anche senza codice) mi da un errore di runtime come se cercasse di applicare la sub Calc all'excel senza codice. Grazie per l'aiuto

Private Sub Worksheet_Calculate()

  Call Calc

End Sub

Sub Calc()

  Static arrOld()

  Static bMsg As Boolean

  Dim rng As Range

  Dim cella As Range

  Dim j As Long

  Dim sInd As String

  Dim bChanged As Boolean

  Set rng = Sheets("New-Quote").Range("d21:d22").SpecialCells(xlCellTypeFormulas, 23)

  ReDim Preserve arrOld(1 To rng.Cells.Count)

  For Each cella In rng

    j = j + 1

    If arrOld(j) <> cella.Value Then

      bChanged = True

      arrOld(j) = cella.Value

      sInd = sInd & cella.Address(0, 0) '& "; "

    End If

  Next

  If bChanged And bMsg Then

    'MsgBox "cambiati i valori in queste celle:" & vbCrLf & _

    sInd

    If Range(sInd).Value = "error!" Then

    'MsgBox "error!"

    Sheets("Input").CommandButton1.Enabled = False

    Sheets("QUOTAZIONE").CommandButton7.Enabled = False

    ElseIf Range(sInd).Value = "ok!" Then

    'MsgBox "ok!"

    Sheets("Input").CommandButton1.Enabled = True

    Sheets("QUOTAZIONE").CommandButton7.Enabled = True

    End If

  Else

    bMsg = True

  End If

  Set rng = Nothing

End Sub

Answer 1

Ciao Salvatore,

Credo che tuo problema sia dovuto al fatto che non hai esplicitamente qualificato gl'intervalli o i fogli del tuo Workbook. Nell'assenza di tale qualificazione,  le istruzioni evidenziate in grassetto saranno tutte interpretate come facendo riferimento al foglio attivo/ cartella di lavoro attiva. Se la cartella di lavoro attiva non è la cartella di lavoro con il codice, si rischia di incontrare il tuo errore di runtime. 

Buonasera,

ho il seguente codice in un foglio di lavoro che mi segnala quando cambia il valore di una cella e di conseguenza mi svolge varie azioni. Finchè ho un solo excel aperto tutto ok, ma appena ne apro un altro (anche senza codice) mi da un errore di runtime come se cercasse di applicare la sub Calc all'excel senza codice. Grazie per l'aiuto

Private Sub Worksheet_Calculate()

  Call Calc

End Sub

Sub Calc()

  Static arrOld()

  Static bMsg As Boolean

  Dim rng As Range

  Dim cella As Range

  Dim j As Long

  Dim sInd As String

  Dim bChanged As Boolean

  

  Set rng = Sheets("New-Quote").Range("d21:d22").SpecialCells(xlCellTypeFormulas, 23)

  ReDim Preserve arrOld(1 To rng.Cells.Count)

  For Each cella In rng

    j = j + 1

    If arrOld(j) <> cella.Value Then

      bChanged = True

      arrOld(j) = cella.Value

      sInd = sInd & cella.Address(0, 0) '& "; "

    End If

  Next

  If bChanged And bMsg Then

    'MsgBox "cambiati i valori in queste celle:" & vbCrLf & _

    sInd

    If Range(sInd).Value = "error!" Then

    'MsgBox "error!"

    Sheets("Input").CommandButton1.Enabled = False

Sheets("QUOTAZIONE").CommandButton7.Enabled = False

    ElseIf Range(sInd).Value = "ok!" Then

    'MsgBox "ok!"

  Sheets("Input").CommandButton1.Enabled = True

Sheets("QUOTAZIONE").CommandButton7.Enabled = True

    End If

  Else

    bMsg = True

  End If

  Set rng = Nothing

End Sub

Pertanto, prova invece:

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

Option Explicit

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

Public Sub Calc()

  Dim WB As Workbook

    Static arrOld()

    Static bMsg As Boolean

    Dim rng As Range

    Dim cella As Range

    Dim j As Long

    Dim sInd As String

    Dim bChanged As Boolean

  Set WB = ThisWorkbook

With WB

        Set rng = .Sheets("New-Quote").Range("d21:d22").SpecialCells(xlCellTypeFormulas, 23)

        ReDim Preserve arrOld(1 To rng.Cells.Count)

        For Each cella In rng.Cells

            j = j + 1

            If arrOld(j) <> cella.Value Then

                bChanged = True

                arrOld(j) = cella.Value

                sInd = sInd & cella.Address(0, 0)    '& "; "

            End If

        Next cella

        If bChanged And bMsg Then

            'MsgBox "cambiati i valori in queste celle:" & vbCrLf & _

             sInd

            If .Range(sInd).Value = "error!" Then

                'MsgBox "error!"

                .Sheets("Input").CommandButton1.Enabled = False

.Sheets("QUOTAZIONE").CommandButton7.Enabled = False

            ElseIf .Range(sInd).Value = "ok!" Then

                'MsgBox "ok!"

              .Sheets("Input").CommandButton1.Enabled = True

.Sheets("QUOTAZIONE").CommandButton7.Enabled = True

            End If

        Else

            bMsg = True

        End If

  End With

    Set rng = Nothing

End Sub

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

Nota  inoltre che, come scritto, l'istruzione:

    sInd = sInd & cella.Address(0, 0) '& "; "

causerebbe un errore se entrambe le celle D21: D22 fossero state modificate.

===

Regards,

Norman

Answer 2

Ciao Salvatore,

Grazie per il cortese riscontro e sono lieti che hai risolto il problema.

Alla prossima!

===

Regards,

Norman

Answer 3

Grazie mille Norman per la risposta! ho modificato come hai suggerito ed è ok!