otomatik çalışan makroyu durdurma

Katılım
2 Temmuz 2009
Mesajlar
542
Excel Vers. ve Dili
office 2019 Türkçe
merhaba üstadlarım. sayfamda otomatik çalışan bir makrom var. aktif hücredeyken yazıyı büyüten bir makro çalışıyor. bu makroyu butonla durdurabilirmiyiz.
teşekkürler. sağlıklı günler dilerim.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim xRg As Range
    Dim xCell As Range
    Dim xShape As Variant
    Set xRg = Target.Areas(1)
    For Each xShape In ActiveSheet.Pictures
        If xShape.Name = "BUYUT" Then
            xShape.Delete
        End If
    Next
    If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
    Application.ScreenUpdating = False
    xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
    Application.ActiveSheet.Pictures.Paste.Select
    With Selection
        .Name = "BUYUT"
        With .ShapeRange
            .ScaleWidth 1.1, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
            With .Fill
                .ForeColor.SchemeColor = 44
                .Visible = msoTrue
                .Solid
                .Transparency = 0
            End With
        End With
    End With
    xRg.Select
    Application.ScreenUpdating = True
    Set xRg = Nothing
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,324
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Boş bir modülde en üst satıra aşağıdaki ifadeyi yazınız.

Butona kodu atadıktan sonra ilk tıkladığınızda macronuz devredışı kalacaktır. İkinci kez tıkladığınızda tekrar devreye girecektir.

C++:
Option Explicit
Public Kontrol As Boolean

Sub My_Macro_Stop_Or_Run()
    Kontrol = Not Kontrol
End Sub
Sonra kullandığınız kodu aşağıdaki gibi değiştiriniz.

C++:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Kontrol = True Then Exit Sub
  
    Dim xRg As Range
    Dim xCell As Range
    Dim xShape As Variant
    Set xRg = Target.Areas(1)
    For Each xShape In ActiveSheet.Pictures
        If xShape.Name = "BUYUT" Then
            xShape.Delete
        End If
    Next
    If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
    Application.ScreenUpdating = False
    xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
    Application.ActiveSheet.Pictures.Paste.Select
    With Selection
        .Name = "BUYUT"
        With .ShapeRange
            .ScaleWidth 1.1, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
            With .Fill
                .ForeColor.SchemeColor = 44
                .Visible = msoTrue
                .Solid
                .Transparency = 0
            End With
        End With
    End With
    xRg.Select
    Application.ScreenUpdating = True
    Set xRg = Nothing
End Sub
 
Katılım
2 Temmuz 2009
Mesajlar
542
Excel Vers. ve Dili
office 2019 Türkçe
Üstad ellerinize sağlık. mükemmel çalışıyor. teşekkür eder sağlıklı günler dilerim.
 
Katılım
2 Temmuz 2009
Mesajlar
542
Excel Vers. ve Dili
office 2019 Türkçe
@Korhan Ayhan üstadım merhaba. öğrenmek için soruyorum. bir buton ekledim üzerine "Büyütmeyi Kapat" diye yazdım. Butona bastığımda makro duruyor. yani yazdığınız makro sorunsuz çalışıyor ama bu anda buton üzerindeki yazıyı makro ile "Büyütmeyi Aç" olarak değiştirilebilir mi. veya buton üzerindeki yazı metni bir hücreden alınabilir mi. teşekkürler...
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,324
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Butonu nerden eklemiştiniz?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,324
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit
Public Kontrol As Boolean

Sub My_Macro_Stop_Or_Run()
    Kontrol = Not Kontrol
    
    If ActiveSheet.Buttons(Application.Caller).Caption = "Büyütmeyi Kapat" Then
        ActiveSheet.Buttons(Application.Caller).Caption = "Büyütmeyi Aç"
    Else
        ActiveSheet.Buttons(Application.Caller).Caption = "Büyütmeyi Kapat"
    End If
End Sub
 
Katılım
2 Temmuz 2009
Mesajlar
542
Excel Vers. ve Dili
office 2019 Türkçe
Korhan Bey olabileceğine çok fazla ihtimal vermiyordum. ellerinize sağlık. çok teşekkür ederim.
 
Katılım
2 Temmuz 2009
Mesajlar
542
Excel Vers. ve Dili
office 2019 Türkçe
@Korhan Ayhan üstadım küçük bir sorun var. şimdi fark ettim. belgeyi açarken butonda "Büyütmeyi Aç" yazıyor ise buton üzerindeki yazı ile makro çalışması ters oluyor. belge kapatıldığında veya açıldığında buton üzerinde "Büyütmeyi Kapat" yazması gerekiyor. ben sizin kodlara göre çok deneme yaptım ama başaramadım.
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,417
Excel Vers. ve Dili
excel 2010
Public BigSmall As Byte


Private Sub ToggleButton1_Click()
If ToggleButton1 = True Then
ToggleButton1.Caption = "Büyük"
BigSmall = 1
Else
ToggleButton1.Caption = "Küçük"
BigSmall = 0
End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If BigSmall = 0 Then Exit Sub

Dim xRg As Range
Dim xCell As Range
Dim xShape As Variant
Set xRg = Target.Areas(1)
For Each xShape In ActiveSheet.Pictures
If xShape.Name = "BUYUT" Then
xShape.Delete
End If
Next
If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
Application.ScreenUpdating = False
xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
Application.ActiveSheet.Pictures.Paste.Select
With Selection
.Name = "BUYUT"
With .ShapeRange
.ScaleWidth 1.1, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
With .Fill
.ForeColor.SchemeColor = 44
.Visible = msoTrue
.Solid
.Transparency = 0
End With
End With
End With
xRg.Select
Application.ScreenUpdating = True
Set xRg = Nothing
End Sub
 
Katılım
2 Temmuz 2009
Mesajlar
542
Excel Vers. ve Dili
office 2019 Türkçe
uzmanamele üstadım olmadı. makroyu çalıştıramadım. aslında sadece açılışta veya kapanışta "Büyütmeyi Kapat" yazması benim için yeterli. ilginize teşekkür ederim.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,324
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Dosyanızın ThisWorkbook (BuÇalışmaKitabı) bölümüne uygulayınız.

Bold bölümleri kendi dosyanıza göre uyarlamalısınız.

Option Explicit

Private Sub Workbook_Open()
Sheets("Sheet1").Buttons("Button 1").Caption = "Büyütmeyi Kapat"
End Sub
 
Katılım
2 Temmuz 2009
Mesajlar
542
Excel Vers. ve Dili
office 2019 Türkçe
üstad harika oldu. internette butona isim atama hakkında hiç bir örnek yoktu. isterseniz bulunması açısından ayrı başlık açayım. teşekkür ederim ellerinize sağlık.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,324
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Arayan bulur merak etmeyin.. ;)
 
Üst