excel vba Errore Run Time 1004

Question

Buon Giorno

Per ridurre il nr. di pulsanti utilizzati in una UserForm , ho assegnato ,una routine da svolgere prima di Uscire al Pulsante  ESCI .

Funziona perfettamente , pero' se Apro la UserForm e Esco (usando il Pulsante Esci)  immediatamente senza fare nessuna azione , ...credo giustamente, si genera un errore  Errore di Run Time '1004'  Errore definito dall'applicazione o dall'Oggetto.

Per Chiudere devo utilizzare la  X  della UserForm .

Il problema di per se' non impedisce l'uso della Macro , pero' vorrei sapere se e' possibile aggirarlo .

il codice e' questo (Realizzato da Norman .... grazie .....)

Private Sub cbEsci_Click()

Dim WB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range, critRng As Range

    Dim oDic As Object

    Dim sStr As String, sUnivco As String

    Dim i As Long, j As Long

    Dim LRow As Long, LCol As Long

    Dim UB As Long, UB2 As Long

    Const sPrimoFoglio As String = "Foglio3"           

    Const sSecondoFoglio As String = "VOTAZIONEA"              

    Const iRigaIntestazioni As Long = 1                             

    Const sPrimaCellaReport As String = "A1"                  

    Const sCriterio As String = "SI"

    Set WB = ThisWorkbook

10

    With WB

        Set srcSH = WB.Sheets(sPrimoFoglio)

        If Not SheetExists(sSecondoFoglio) Then

            Set destSH = .Sheets.Add(after:=srcSH)

            destSH.Name = sSecondoFoglio

        Else

            Set destSH = .Sheets(sSecondoFoglio)

        End If

    End With

    With srcSH

        LRow = LastRow(srcSH, .Columns("A"))

        LCol = LastCol(srcSH, .Rows(1))

        Set srcRng = .Range("A" & iRigaIntestazioni + 1) _

                     .Resize(LRow - 1, LCol)

    End With

    Set destRng = destSH.Range(sPrimaCellaReport)

    vArrIn = srcRng.Value

    ReDim vArrOut(1 To UBound(vArrIn), 1 To UBound(vArrIn, 2) - 1)

    Set oDic = CreateObject("Scripting.Dictionary")

    With oDic

        .CompareMode = 0

        For i = LBound(vArrIn) To UBound(vArrIn)

            If UCase(vArrIn(i, 1)) = UCase(sCriterio) Then

                '\ Nome&Cognome&D.Nascita

                sUnivco = vArrIn(i, 2) & vArrIn(i, 3) & vArrIn(i, 4)

                If Not .exists(sUnivco) Then

                    j = j + 1

                    .Add Key:=sUnivco, Item:=vbNullString

                    Call CaricaRinnovi(i, j)

                End If

            End If

        Next i

    End With

    UB2 = UBound(vArrOut, 2)

    With destRng

        .Parent.UsedRange.ClearContents

        .Offset(1).Resize(j, UB2).Value = vArrOut

        .Resize(1, UB2).Value = srcRng.Cells(0, 2).Resize(1, UB2).Value

        Call FormatReport(.CurrentRegion)

    End With

20

    Appello.Hide

End Sub

Grazie  per qualsiasi suggerimento              Claudio P

Answer 1

Ciao Claudio,

Effettivamente il problema e' generato dall'assenza nella colonna A di qualsiasi dato e questo perche'  la routine che copia i dati solo se si verifica la condizione  SI  presente nella Colonna A del Foglio 3  dovrebbe essere  l'ultima prima di uscire cbEsci   e  l'errore si verifica  solo se uno  Apre l'UserForm  e  chiude immediatamente con pulsante ESCI  senza fare nessuna azione  .

Non avendo fatto partire nessuna azione , non trova nessun dato .

La riga evidenziata in giallo quando si verifica l'errore e'

.Offset(1).Resize(j, UB2).Value = vArrOut

So che la soluzione immediata sarebbe aggiungere un pulsante   cbSalvaSI che fa partire la routine  e lasciare al cbEsci solo   Chiudi UserForm   ...... ma se possibile vorrei evitarlo

Ho caricato su DropBox il File depurato dei dati sensibili a questo link

https://www.dropbox.com/s/i8i9ucfix5ioawx/Claudio%20Appello.xlsm?dl=0

Nella procedura cbEsci_Click nel modulo di codice della Userform Appello, sostituisci l'ultimo blocco di codice:

    UB2 = UBound(vArrOut, 2)

    With destRng

        .Parent.UsedRange.ClearContents

        .Offset(1).Resize(j, UB2).Value = vArrOut

        .Resize(1, UB2).Value = srcRng.Cells(0, 2).Resize(1, UB2).Value

        Call FormatReport(.CurrentRegion)

    End With

con:

    If oDic.Count Then

        UB2 = UBound(vArrOut, 2)

        With destRng

            .Parent.UsedRange.ClearContents

            .Offset(1).Resize(j, UB2).Value = vArrOut

            .Resize(1, UB2).Value = srcRng.Cells(0, 2).Resize(1, UB2).Value

            Call FormatReport(.CurrentRegion)

        End With

    End If

===

Regards,

Norman

Answer 2

Ciao Claudio, 

Perfetto   Grazie  e  Buona Settimana    

Bene :-)

Ti ringrazio per il cortese riscontro.

Alla prossima.

===

Regards,

Norman

Answer 3

Buon Giorno Norman

Perfetto   Grazie  e  Buona Settimana     Claudio P

Answer 4

Buon Giorno Norman

Effettivamente il problema e' generato dall'assenza nella colonna A di qualsiasi dato e questo perche'  la routine che copia i dati solo se si verifica la condizione  SI  presente nella Colonna A del Foglio 3  dovrebbe essere  l'ultima prima di uscire cbEsci   e  l'errore si verifica  solo se uno  Apre l'UserForm  e  chiude immediatamente con pulsante ESCI  senza fare nessuna azione  .

Non avendo fatto partire nessuna azione , non trova nessun dato .

La riga evidenziata in giallo quando si verifica l'errore e'

.Offset(1).Resize(j, UB2).Value = vArrOut

So che la soluzione immediata sarebbe aggiungere un pulsante   cbSalvaSI che fa partire la routine  e lasciare al cbEsci solo   Chiudi UserForm   ...... ma se possibile vorrei evitarlo

Ho caricato su DropBox il File depurato dei dati sensibili a questo link

https://www.dropbox.com/s/i8i9ucfix5ioawx/Claudio%20Appello.xlsm?dl=0

Grazie  per  la tua pazienza ....   Grazie    Claudio P

Answer 5

Ciao Claudio,

Per ridurre il nr. di pulsanti utilizzati in una UserForm , ho assegnato ,una routine da svolgere prima di Uscire al Pulsante  ESCI .

Funziona perfettamente , pero' se Apro la UserForm e Esco (usando il Pulsante Esci)  immediatamente senza fare nessuna azione , ...credo giustamente, si genera un errore  Errore di Run Time '1004'  Errore definito dall'applicazione o dall'Oggetto.

Per Chiudere devo utilizzare la  X  della UserForm .

Il problema di per se' non impedisce l'uso della Macro , pero' vorrei sapere se e' possibile aggirarlo .

il codice e' questo (Realizzato da Norman .... grazie .....)

Private Sub cbEsci_Click()

 

Dim WB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range, critRng As Range

    Dim oDic As Object

    Dim sStr As String, sUnivco As String

    Dim i As Long, j As Long

    Dim LRow As Long, LCol As Long

    Dim UB As Long, UB2 As Long

 

    Const sPrimoFoglio As String = "Foglio3"           

    Const sSecondoFoglio As String = "VOTAZIONEA"              

    Const iRigaIntestazioni As Long = 1                             

    Const sPrimaCellaReport As String = "A1"                  

    Const sCriterio As String = "SI"

 

    Set WB = ThisWorkbook

10

 

    With WB

        Set srcSH = WB.Sheets(sPrimoFoglio)

        If Not SheetExists(sSecondoFoglio) Then

            Set destSH = .Sheets.Add(after:=srcSH)

            destSH.Name = sSecondoFoglio

        Else

            Set destSH = .Sheets(sSecondoFoglio)

        End If

    End With

 

    With srcSH

        LRow = LastRow(srcSH, .Columns("A"))

        LCol = LastCol(srcSH, .Rows(1))

        Set srcRng = .Range("A" & iRigaIntestazioni + 1) _

                     .Resize(LRow - 1, LCol)

    End With

 

    Set destRng = destSH.Range(sPrimaCellaReport)

 

    vArrIn = srcRng.Value

    ReDim vArrOut(1 To UBound(vArrIn), 1 To UBound(vArrIn, 2) - 1)

    Set oDic = CreateObject("Scripting.Dictionary")

 

    With oDic

        .CompareMode = 0

        For i = LBound(vArrIn) To UBound(vArrIn)

            If UCase(vArrIn(i, 1)) = UCase(sCriterio) Then

                '\ Nome&Cognome&D.Nascita

                sUnivco = vArrIn(i, 2) & vArrIn(i, 3) & vArrIn(i, 4)

                If Not .exists(sUnivco) Then

                    j = j + 1

                    .Add Key:=sUnivco, Item:=vbNullString

                    Call CaricaRinnovi(i, j)

                End If

            End If

        Next i

    End With

 

    UB2 = UBound(vArrOut, 2)

    With destRng

        .Parent.UsedRange.ClearContents

        .Offset(1).Resize(j, UB2).Value = vArrOut

        .Resize(1, UB2).Value = srcRng.Cells(0, 2).Resize(1, UB2).Value

        Call FormatReport(.CurrentRegion)

    End With

   

20

   

    Appello.Hide

End Sub

Sarebbe stato utile se tu avessi caricato un file di esempio per dimostrare il problema e se tu avessi anche indicato quale istruzione fosse stata evidenziata in giallo quando hai riscontato l'errore.

In mancanza di tali informazioni, vorrei suggerire che si riscontrerebbe questo errore se non ci fossero dati sotto l'intestazione della colonna A sul Foglio3. 

===

Regards,

Norman