Düğmeyi nesneye atama

[excellkurdu]

Tek düğme ile tüm kitabı hesaplatma

Merhaba Arkadaşlar, Sitede çok örneği var zaten kodu da siteden aldım ama kendime uyarlayamadım. Altaki 93 excell düğme butonu ile çalışan kodu, Sub ile çalıştıramadım.

Private Sub CommandButton1_Click()
If CommandButton1.Caption = "OTOMATİK" Then
    CommandButton1.Caption = "EL İLE"
    Application.Calculation = xlManual
Else
    CommandButton1.Caption = "OTOMATİK"
    Application.Calculation = xlAutomatic
End If
End Sub

Yukardaki kodu alt aralığa nasıl ekleriz. Amacım yukardaki tek düğme ile çalışan kodu, 2007 excellde eklediğim şekillerde çalıştırmak.

Sub CommandButton1_Click()
'Yukardaki kod buraya eklenecek.
End Sub

Saygılarımla

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Dikdörtgen_Tıklat()
 
    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

.

 

[excellkurdu]

Set nesne = ActiveSheet.Shapes("1 Dikdörtgen") burda hata verdi. Belirtilen nesne bulunamadı. Ekteki dosyaya uyarlarsanız sevinirim. Şimdiden teşekkür ederim

 

[Ömer]

Ekteki dosyada deneyek yazmıştım.

Kodları module kopyalayın, daha sonra sayfa üzerindeki nesneye sağ klik yaparak "Makro ata" seçeneğini işeretleyip açılan ekrandan "Dikdörtgen_Tıklat" işaretleyip tamam ile işlemi bitirin.

 

[excellkurdu]

Ekteki dosyada deneyek yazmıştım.

Kodları module kopyalayın, daha sonra sayfa üzerindeki nesneye sağ klik yaparak "Makro ata" seçeneğini işeretleyip açılan ekrandan "Dikdörtgen_Tıklat" işaretleyip tamam ile işlemi bitirin.

Hocam haklısınız. ekteki dosyada çalışıyor, ama asıl dosyamda aynı hatayı alıyorum.Aynı yolları izliyorum ve bu hatayı veriyor ;belirtilen adlı öğe bulunamadı.

 

[Ömer]

Nesenin ismi farkılıdır. Kırmızı alanı kendi dosyanıza göre uyarlayınız.

Set nesne = ActiveSheet.Shapes("1 Dikdörtgen")

 

[excellkurdu]

Ömer Bey zamanınızı aldım kusura bakmayın. Şimdide şöle bir sıkıntım oldu. Sayfa1, Sayfa2 ve Sayfa3 den herhangi birine tıkladığımda sadece o sayfadaki yazılar değişiyor. Oysa tüm sayfaların hesaplaması değişmesine rağmen (Çalışıyor sıkıntı yok), Sayfa1, Sayfa2 ve Sayfa3 kutucukların içlerindeki yazıların da değişmesini nasıl yapabiliriz?

 

[Ömer]

Ek olarak aşağıdaki kodları ThisWorkbook sayfasına ekleyin;

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 
    Dim nesne As Shape
 
    Set nesne = ActiveSheet.Shapes("[COLOR=red]1 Dikdörtgen[/COLOR]")
 
    If Application.Calculation = xlManual = True Then
        nesne.TextFrame.Characters.Text = "EL İLE"
    Else
        nesne.TextFrame.Characters.Text = "OTOMATİK"
    End If
 
End Sub

.

 

[excellkurdu]

Allah Razı olsun çalıştı. Sadece bu nesne tüm sayfalarda da olmadığından, olanlarda çalıştı olmayanlarda belirtilen adlı öğe bulunamadı dedi. Onuda sizi yormuyayım düzeltebilirim sanırım.
Çok teşekkür ediyorum

 

[Ömer]

İlaveyi kırmızı ile işaretledim.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 
    Dim nesne As Shape
 
[COLOR=red]    On Error Resume Next
[/COLOR]    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]

ömer Bey tekrar Allah razı olsun. Muhteşem çalışdı. Sorunlar kalmadı. Çok teşekkür ederim.