Application-defined or object-defined error hatası

[AKREP1]

Sub koru()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Protect "1111"
Next
Application.ScreenUpdating = True
End Sub
Sub koruac()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Unprotect "1111"
Next
Application.ScreenUpdating = True
End Sub
diye bir makrovar.Run-time error
Application-defined or object-defined error
diye bir hata çıkıyor.Bu nedir nasıl düzeltilir.Saygılarımla

 

[Ömer]

Merhaba,

Bu kodlarda sorun gözükmüyor. Kullandığınız dosyada bu kodların dışında kod varmı.

Hata aldığınız dosyayı ekleyebilirmisiniz...

.

 

[AKREP1]

Merhaba Ömer Bey ilginiz için teşekkürler dosya boyutu çok olduğu için sadece olan kodları gönderiyorum saygılar.
HATA ALDIĞIM SAYFA

Private Sub Workbook_Open()
FirstSheet
koru
ThisWorkbook.Autpen
End Sub
Sub Autpen()
Static sayac As Integer
Do
If sayac = 3 Then
ThisWorkbook.Close False
Else
If InputBox("Şifreyi girin") = "4444" Then
GoTo devam
Else
sayac = sayac + 1
End If
End If
Loop
devam:
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [d:aj]) Is Nothing Then Exit Sub
If Target.Cells.Value > 99 Then
Target.Cells.Font.Size = 8
Else
Target.Cells.Font.Size = 10
End If
End Sub

DİĞER KODLAR
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Single
Dim ilk, son, veri As String
Do While (True)
DoEvents
ilk = Left(Cells(1, 1), 1)
son = Mid(Cells(1, 1).Value, 2, Len(Cells(1, 1).Value) - 1)
Cells(1, 1).Value = son + ilk
Range("a9") = Format(Now(), "dd mm yyyy")
Range("a10") = Format(Now(), "hh:mm:ss")
DoEvents
For i = 1 To 12000000
Next i
veri = Cells(1, 1).Value
Loop
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "1111"
Cells.Interior.ColorIndex = 1 'Turn off previous use Cells.Interior.ColorIndex = 1 'Turn off previous use
If Cells(1, 1) = "." Then GoTo son
Target.EntireRow.Interior.ColorIndex = 5
son:
ActiveSheet.Protect "1111"
End Sub


Sub Hesap_makinesi()
Application.ActivateMicrosoftApp Index:=0
End Sub


Sub FirstSheet()
Sheets(1).Select
End Sub
Sub kayıt()
ActiveWorkbook.Save
End Sub


Sub Autpen()
Dim i As Integer
For i = 1 To Sheets.Count
Sheets(i).ScrollArea = Sheets(i).Range("A44").Value
Next i
End Sub