[VBA/OFFICE]: Macro di Excel causa errore irreversibile

[sanvy]

sto seguendo una guida su una rivista di programmazione dove insegnavano a creare un videogioco in ecxel con lla macro, io ho seguito tutto, ricontrollato 5 volte e ora che il codice è del tutto corretto, appena avvio il documento con la macro attiva, ecxel mi si chiude con un messaggio
"si è verificato un errore in Microsoft Ecxell. Lapplicazione Verrà Chiusa."
io cosa devo fare? mi aiutate? per me questo progetto è molto imporante!!!
grazie!

[alka]

Il primo passo per risolvere il problema è quello di scrivere nel forum giusto, usare un titolo significativo e, nel caso in esame, riportare anche un po' di codice.

Alle prime due ho già rimediato io...

Ciao!

[sanvy]

per il codice sono 3 pagine stampate in formato 10 con word
se occorre la copio anche tutta, ma ho icontrollato 5 volte dalla guida alla macro
di seguito specificherò il codice


Option Explicit
Const CarBomba As String = "M"
Const Ignoto As Integer = 15 'grigio
Const Vuoto As Integer = xlNone 'nessuno
Const Forse As Integer = 6 'giallo
Const Bomba As Integer = 3 'rosso
Dim Finegioco As Boolean
Dim TempoInizio As Date
Private Sub creaplancia(TargetCell As Range, Riga As Long, Cln As Long)
Dim r1 As Long, c1 As Long, r2 As Long, c2 As Long, Plancia As Range
Dim nf As String
Application.ScreenUpdating = False
r1 = TargetCell.Cells(1, 1).Row
c1 = TargetCell.Cells(1, 1).Column
r2 = r1 + -1
c2 = c1 + Cln - 1
ActiveSheet.Unprotect
Set Plancia = Range(Cells(r1, c1), Cells(r2, c2))
With Plancia
.ClearContents
.Interior.ColorIndex = Ignoto
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
.RowHeight = 19
.ColumnWidth = 5
End With
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

Sub NuovaPartita()
Dim Plancia As Range
Call creaplancia(Range("C6"), 8, 8)
Set Plancia = Range("Plancia")
Range("BombeTrovate").Formula = "?"
Range("ERRORI").Formula = "?"
Range("TOTALI").Formula = "15"
Call InserisciBombe(Range("Totali").Value, Plancia)
Call Aggiorna
Finegioco = False
TempoInizio = 0
End Sub

Sub InserisciBombe(ContaMine As Long, CellaDest As Range)
Dim X As Long, Y As Long, BombeInserite As Long
ActiveSheet.Unprotect
CellaDest.ClearContents
CellaDest.Font.Name = "WingDings"
CellaDest.NumberFormat = ";;;"
CellaDest.Interior.ColorIndex = Ignoto
Randomize
Do While BombeInserite < ContaMine
X = Int(Rnd * CellaDest.Rows.Count) + 1
Y = Int(Rnd * CellaDest.Columns.Count) + 1
With CellaDest.Cells(X, Y)
If .Formula = "" Then
.Formula = CarBomba
BombeInserite = BombeInserite + 1
End If
End With
Loop
ActiveSheet.Protect
End Sub

Sub ControllaCella(IndirizzoZona As String)
If Not DentroZona(Range(IndirizzoZona).Cells(1, 1), Range("Plancia")) Then Exit Sub
If Finegioco Then
If MsgBox("Tempofinito! Vuoi giocare ancora?", vbQuestion + vbYesNo) = vbYes Then Call NovaPartita
Exit Sub
End If
If TempoInizio < 1 Then TempoInizio = Now
With Range(IndirizzoZona).Cells(1, 1)
If .Formula = CarBomba Then
Finegioco = True
Call MostraTotali
Else
Call MostraAdiacenti(IndirizzoZona, True)
End If
End With
Call Aggiorna
End Sub

Sub ContrassegnaCella(IndirizzoZona As String)
If Not DentroZona(Range(IndirizzoZona).Cells(1, 1), Range("Plancia")) Then Exit Sub
If Finegioco Then
If MsgBox("Tempofinito! Vuoi giocare ancora?", vbQuestion + vbYesNo) = vbYes Then Call NovaPartita
Exit Sub
End If
ActiveSheet.Unprotect
With Range(IndirizzoZona).Cells(1, 1)
Select Case .Interior.ColorIndex
Case Ignoto
.Interior.ColorIndex = Bomba
Case Forse
.Interior.ColorIndex = Ignoto
Case Bomba
.Interior.ColorIndex = Forse
End Select
End With
ActiveSheet.Protect
Call Aggiorna
End Sub

Sub MostraAdiacenti(IndirizzoZona As String, Ricorsivo As Boolean)
Dim r As Long, c As Long, CellaDest As Range, c1 As Range
r = Range(IndirizzoZona).Cells(1, 1).Row
c = Range(IndirizzoZona).Cells(1, 1).Column
If r < 1 Or c < 1 Then Exit Sub
Set CellaDest = Range(Cells(r, c), Cells(r + 2, c + 2))
r = Application.WorksheetFunction.CountA(CellaDest)
c = Application.WorksheetFunction.Count(CellaDest)
If DentroZona(Range(IndirizzoZona).Cells(1, 1), Range("Plancia")) Then
Range(IndirizzoZona).Cells(1, 1).NumberFormat = "General"
Range(IndirizzoZona).Cells(1, 1).Font.Name = "arial"
Range(IndirizzoZona).Cells(1, 1).Interior.ColorIndex = Vuoto
If r - c > 0 Then
Range(IndirizzoZona).Cells(1, 1).Formula = r - c
Else
If Ricorsivo Then
For Each c1 In CellaDest
If c1.Address <> Range(IndirizzoZona).Cells(1, 1).Address Then
End If
Next c1
End If
End If
End If
ActiveSheet.Protect
End Sub

Sub MostraBombe(CellaDest As Range)
Dim c1 As Range: ActiveSheet.Unprotect
For Each c1 In CellaDest
If c1.Formula = CarBomba Then c1.NumberFormat = "General"
Next c1: ActiveSheet.Protect
End Sub
Private Function DentroZona(origine As Range, Dest As Range) As Boolean
Dim c1 As Range
Set c1 = Intersect(origine, Dest): DentroZona = Not c1 Is Nothing
End Function
Private Function CelleColore(Dest As Range, Interno As Integer) As Long
Dim c1 As Range, c As Long
For Each c1 In Dest
If c1.Interior.ColorIndex = Interno Then c = c + 1
Next c1: CellaColore = c
End Function
Private Sub Aggiorna()
Dim Rimaste As Long
Range("Totali").Formula = Applicatin.WorksheetFunction.CountA _
(Range("Plancia")) - Application.WorksheetFunction.Count _
(Range("Plancia"))
Range("Contrassegnate").Formula = CelleColore(Range("Plancia"), Bomba)
Rimaste = CelleColore(Range("Plancia"), Ignoto) + _
CelleColore(Range("Plancia"), Forse)
If Rimaste = 0 And Not Finegioco Then MostraTotali
End Sub

Private Sub MostraTotali()
Dim Trovate As Long, NonTrovate As Long
Dim Er As Long, c1 As Range, Plancia As Range
Set Plancia = Range("Plancia"): ActiveSheet.Unprotect
For Each c1 In Plancia
Select Case c1.Interior.ColorIndex
Case Ignoto
c1.Interior.ColorIndex = xlNone
If c1.Formula = CarBomba Then NonTrovate = NonTrovate + 1
Case Forse
If c1.Formula = CarBomba Then NonTrovate = NonTrovate + 1
Case Bomba
If c1.Formula = CarBomba Then Trovate = Trovate + 1 Else Er = Er + 1
End Select
Next c1
Range("Trovate").Formula = Trovate: Range("Er").Formula = Er
Call MostraBombe(Plancia): ActiveeSheet.Protect
If Not Finegioco Then
MsgBox "Hai vinto!! Tempo: " & Format(Now - TempoInizio, "hh:mm:ss"), _
vbInformation + vbOKOnly, "Congratulazioni!!!"
Else
MsgBox "Hai vinto!! Tempo: " & Format(Now - TempoInizio, "hh:mm:ss"), _
vbExlamation + vbOKOnly, "KABOOOM!!!"
End If
Finegioco = True
End Sub