Characters sınıfının Text özelliği kullanılamıyor hatası

[excellkurdu]

Merhaba Arkadaşlar,
Sayfayı Koru özelliğini açınça Otomatik ve Elle hesaplama Makrosu "Characters sınıfının Text özelliği kullanılamıyor" hatası veriyor. Sayfalarım bozulmasın diye ve sadece izin verilen aralıkların kullanılması için, Bazı sayfalardaki hücrelerimi "kilitli" ve "Sayfayı Koru" ile şifreledim. Bu sorunu nasıl aşabilirim.
Otomatik hesaplama makrom;

Sub Hesaplama()
'otomatik yada elle hesaplatma
    Dim nesne As Shape
    Set nesne = ActiveSheet.Shapes("1 Dikdörtgen")
    If nesne.TextFrame.Characters.Text = "OTOMATİK" Then
        nesne.TextFrame.Characters.Text = "EL İLE"
        Application.Calculation = xlManual
    Else
        nesne.TextFrame.Characters.Text = "OTOMATİK"
        Application.Calculation = xlAutomatic
    End If
End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Hesaplama()
'otomatik yada elle hesaplatma
    Dim nesne As Shape
    
    ActiveSheet.Unprotect "[COLOR=red]şifreniz[/COLOR]"
    
    Set nesne = ActiveSheet.Shapes("1 Dikdörtgen")
    If nesne.TextFrame.Characters.Text = "OTOMATİK" Then
        nesne.TextFrame.Characters.Text = "EL İLE"
        Application.Calculation = xlManual
    Else
        nesne.TextFrame.Characters.Text = "OTOMATİK"
        Application.Calculation = xlAutomatic
    End If
    
    ActiveSheet.Protect "[COLOR=red]şifreniz[/COLOR]"
    
End Sub

.

 

[excellkurdu]

Hocam Bu hata kalktı. Şöyle hata verdi şimdide. Elle/Automatic olan şekil deki EL-OTOMATİK olan yazı diğer sayfalarda değişmiyor. Değişmesi içinde ThisWorkbook sayfasına şu kodu eklemiştim. Burdada yardımcı olursanız sevinirim.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Sayfaların elle yada otomatik hesaplanması, diğer sayfalar için buraya yazdım
 
    Dim nesne As Shape
    
    On Error Resume Next
    Set nesne = ActiveSheet.Shapes("1 Dikdörtgen")
 
    If Application.Calculation = xlManual = True Then
        nesne.TextFrame.Characters.Text = "EL İLE"
    Else
        nesne.TextFrame.Characters.Text = "OTOMATİK"
    End If
 
End Sub

 

[excellkurdu]

Hocam Sağolun düzelltim aynı düşünceyle şifre ekledim çözüldü. Allah razı olsun.