Gringoire
Board Regular
- Joined
- Nov 18, 2016
- Messages
- 71
- Office Version
- 365
- Platform
- Windows
Dear friends, once again I need your valuable help.
My project (started on March '23) is growing up day by day becoming quite complex.
On friday I noticed a bug making Excel crashing (and sometime restarting). The bug is not trapped by VBA debugger: when I run the code step by step it does not happens!
Long story short, when my code does a copy paste operation on a row, from a template sheet to a working sheet, it correctly complete the routine but after a few seconds Excel suddenly crashes without any error message. The issue seems to be related with the last Case Else block of the routine below, but I cant point out any error.
I already restarted in safe mode to save a copy of xlsm file but the error still remains.
What could I do to remove this annoying bug?
Thanks in advance.
My project (started on March '23) is growing up day by day becoming quite complex.
On friday I noticed a bug making Excel crashing (and sometime restarting). The bug is not trapped by VBA debugger: when I run the code step by step it does not happens!
Long story short, when my code does a copy paste operation on a row, from a template sheet to a working sheet, it correctly complete the routine but after a few seconds Excel suddenly crashes without any error message. The issue seems to be related with the last Case Else block of the routine below, but I cant point out any error.
I already restarted in safe mode to save a copy of xlsm file but the error still remains.
What could I do to remove this annoying bug?
Thanks in advance.
VBA Code:
Sub SK_doaction(azione As String, descrizione, chiamante, Optional testodescrittivo = "")
'=================================================================================
'Faccio le opportune verifiche e se su quella riga è permessa l'azione, la compio.
'azione identifica l'azione da fare: (option, group, brow, delete, copy, move, riga scomm.)
'descrizione
'chiamante
'testodescrittivo: usato per evitare gli inputbox
'=================================================================================
'VERIFICO che la selezione è editabile.
If Not SK_chkedit(azione) Then Exit Sub
'VERIFICO se è una multiselezione e se è valida
Dim multiselezione As Boolean
multiselezione = False
If Selection.Rows.Count > 1 Then
multiselezione = True
If SK_isspecialrowselected(Selection) Then
MsgBox "Special rows cannot be included into the selection." & vbCrLf & "Please try again."
Exit Sub
End If
End If
'VERIFICO che su quella selezione è permessa l'azione
If Not SK_chkaction(azione, multiselezione) Then Exit Sub
'COMPIO l'azione (option, group, brow, delete, copy, move, riga scomm.)
Dim risposta As String
Selection.EntireRow.Select
Select Case azione
Case "OPTION" 'Caso inserimento OPZIONE
risposta = InputBox("Insert item description", "INFORMATION REQUEST")
risposta = isunivoque(shSK.Name, SKC.desc, "Option: " & UCase(risposta)) 'Verifico che la descrizione sia univoca.
If risposta = "" Then
MsgBox "This description already exists"
Exit Sub
End If
'inserisco l'opzione
shDEV_Template.Rows(str_OpTempl).Copy
Selection.Insert Shift:=xlDown
Selection.Cells(1, SKC.desc).Offset(1, 0).Value = risposta
Case "GROUP" 'Caso inserimento GRUPPO
If testodescrittivo = "" Then '
risposta = InputBox("Insert item description", "INFORMATION REQUEST")
risposta = isunivoque(shSK.Name, SKC.desc, "Description: " & UCase(risposta)) 'Verifico che la descrizione sia univoca.
If risposta = "" Then
MsgBox "This description already exists"
Exit Sub
End If
Else
risposta = testodescrittivo
End If
'inserisco l'opzione
shDEV_Template.Rows(str_GrTempl).Copy
Selection.Insert Shift:=xlDown
Selection.Cells(1, SKC.desc).Value = risposta
Case "BROW" 'Caso inserimento RIGA VUOTA
shDEV_Template.Rows(n_BlTempl).Copy
Selection.Insert Shift:=xlDown
Case "DELETE", "CUT", "COPY", "INCLUDI OPZ", "ADDORDER" 'Casi DELETE, CUT, COPY: setto il range.
Dim zona As LongLong 'limite opposto del range da eliminare
Dim init_Sel As Long
Dim destinazione As LongLong
zona = 1 'setto la zona a 1 riga
init_Sel = Selection.Row 'memorizzo la selezione iniziale
If Cells(Selection.Row, SKC.scom).Value = str_OPT Or Cells(Selection.Row, SKC.scom).Value = str_GRO Then
risposta = MsgBox("You are going to work on an entire BLOCK. Are you sure?", vbYesNo, "ATTENTION!")
If risposta = vbNo Then Exit Sub
End If
If Cells(Selection.Row, SKC.scom).Value = str_OPT Then
zona = numriga(shSK.Name, str_EOP, SKC.scom, Selection.Row, xlNext) - Selection.Row + 1 'Caso inizio OPZIONE
Selection.Resize(zona).Select
ElseIf Cells(Selection.Row, SKC.scom).Value = str_GRO Then
zona = numriga(shSK.Name, str_EGR, SKC.scom, Selection.Row, xlNext) - Selection.Row + 1 'Caso inizio GRUPPO
Selection.Resize(zona).Select
End If
'SCELGO TRA DELETE, COPY, MOVE ed INCLUDI OPZ
If azione = "DELETE" Then 'CANCELLO la selezione
Selection.Delete
ElseIf azione = "COPY" Then 'COPIO la selezione
Selection.Copy
ElseIf azione = "CUT" Then 'TAGLIO la selezione
Selection.Cut
ElseIf azione = "INCLUDI OPZ" Then 'INSERISCO UN OPZIONE IN CMS
destinazione = numriga(shSK.Name, str_endCMS, SKC.scom, 1, xlNext) - 1
Selection.Cut
Rows(destinazione).Select
Selection.Insert Shift:=xlDown
Cells(Selection.Row, SKC.desc).Value = Cells(Selection.Row, SKC.desc).Value
End If
Case "PASTE" 'INCOLLO una parte precedentemente copiata o tagliata
'Controllo che ci sia effettivamente un CUT o COPY attivo
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then
Dim contenuto As DataObject
Dim testo As String, numlines As Long
On Error Resume Next
Set contenuto = New DataObject
contenuto.GetFromClipboard 'Carico il clipboard in contenuto
testo = contenuto.GetText 'Lo estraggo come righe di testo
numlines = UBound(Split(testo, vbCrLf)) 'Vedo quante righe sono
If numlines > 1 Then 'Se è più di una vedo se è un gruppo, un opzione o altro
Select Case Left(Split(testo, vbCrLf)(0), 9)
Case "INIOPTION" 'Ho selezionato una OPZIONE non può stare dentro un'opzione o un gruppo
If isInside("OPT") Or isInside("GRO") Then
MsgBox "It is not possible to insert an Option inside another option or group."
Application.CutCopyMode = False
Exit Sub
End If
Case "INIGROUP#" 'Ho selezionato un GRUPPO non può stare dentro un gruppo
If isInside("GRO") Then
MsgBox "It is not possible to insert a Group inside another group. "
Application.CutCopyMode = False
Exit Sub
End If
Case Else 'Ho selezionato più righe che non sono nè gruppo nè opzione
If Not isInside("CMS") And Not isInside("OPT") Then 'Sto cercando di copiare fuori da cms o opzione
MsgBox "It is not possible to paste this selection outside CMS or Option."
Application.CutCopyMode = False
Exit Sub
ElseIf InStr(testo, "#") <> 0 Then 'Ho trovato # (quindi una riga speciale)
MsgBox "It is not possible to paste this selection because it contains special rows."
Application.CutCopyMode = False
Exit Sub
End If
End Select
End If
Selection.Insert Shift:=xlDown 'Se non ci sono controindicazioni INSERISCO
End If
Application.CutCopyMode = False
Case Else 'Caso inserimento RIGA ITEM STANDARD
Dim tiporiga As Integer
tiporiga = shDEV_SCOM.Cells(numriga(shDEV_SCOM.Name, azione, 1, 5, xlNext), 12).Value2 'individuo il tipo di riga da inserire a seconda della Scomm
'copio
If tiporiga = 1 Then
shDEV_Template.Rows(n_RwTempl).Copy 'Riga normale
ElseIf tiporiga = 43 Then
shDEV_Template.Rows(n_RwTemp43).Copy 'Utilizzata per verniciatura
ElseIf tiporiga = 62 Then
shDEV_Template.Rows(n_RwTemp62).Copy 'Riga di PROGETTAZIONE "PR0000", "PR0005", "PR0010", "PR0015"
ElseIf tiporiga = 63 Then
shDEV_Template.Rows(n_RwTemp63).Copy 'Riga outsourcing
ElseIf tiporiga = 107 Then
shDEV_Template.Rows(n_RwTemp107).Copy 'Riga cantiere
Else
shDEV_Template.Rows(n_RwTempl).Copy 'altro non identificato (copio riga standard)
End If
'inserisco
If Cells(Selection.Row, SKC.scom).Value = str_BLA Then
ActiveSheet.Paste
Else
Selection.Insert Shift:=xlDown
End If
Application.CutCopyMode = False 'test
Cells(Selection.Row, SKC.scom).Value = azione 'inserisco la sottocommessa dalla lista
End Select
Cells(Selection.Row, SKC.desc).Select 'deseleziono l'intera riga
End Sub
