Makro ile şekil büyütüp küçültme.

[kaya41]

Herkese merhaba.

Bir sayfa içerisinde onlarca şekil var.
Yapmak istediğim Şekillerden birini tıkladığımda tıkladığım şekil büyüsün. Tekrar tıkladığımda küçülsün.
Sadece tıkladığım şekil büyüyüp küçülecek.

Bulduğum kısımı aşağıda paylaşıyorum.
Şeklin adını kullandığım için sadece adı geçen şekil büyüyüp küçülüyor. Şeklin adı yerine Active Shapes gibi bir şey yapmak mümkün mü?

Bir de tıkladığım şeklin en önde gösterimini sağlayacak koda ihtiyacım var.

destekleriniz için şimdiden herkese teşekkür ederim.

Kullandığım kod.

Sub byt()
Dim sekiller As Shape


kontrol = Not kontrol


If kontrol Then
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 25")).Select

    Selection.ShapeRange.ScaleWidth 5.8823602067, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 5.5744629142, msoFalse, msoScaleFromTopLeft
Else
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 25")).Select
    Selection.ShapeRange.ScaleWidth 0.3133337533, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.4503814151, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleWidth 0.5531916414, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.4067793835, msoFalse, msoScaleFromTopLeft
  
End If


End Sub

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodu kullanabilirsiniz.
(Eğer hiçbir şekil seçili değilse işlem yapmaz.)

Sub byt()
    Dim sekiller As Shape, kontrol
    kontrol = Not kontrol
    On Error Resume Next
    If kontrol Then
        Selection.ShapeRange.Width = 50
        Selection.ShapeRange.Height = 50
    Else
        Selection.ShapeRange.Width = 3
        Selection.ShapeRange.Height = 4
    End If
    Selection.ShapeRange.ZOrder msoBringToFront
End Sub

 

[kaya41]

Merhaba.
ilginiz için teşekkür ederim.

Kodlarda C++ belirtmişsiniz.

Ben excelde uygulayamadım.

Excel için alternatif bir öneresi olan var mı?

 

[YUSUF44]

C++ nitemelesi paylaşılan kod bloğunun bu sayfa üzerinde nasıl görüneceğini gösteriyor. Yani orda C++ yazdığı için o kodları bir kutu içinde ve düzenli bir şekilde görüyoruz. Kodun türüyle bir ilgisi yok.

Kodları kopyalayıp excelde VBA editörünü açın, insert menüsünden module'yi seçin ve kodları açılan sayfaya yapıştırın. Daha sonra bu kodu çalıştırabilirsiniz.

 

[Seyit Tiken]

Örnek kodu kendinize uyarlayıp deneyiniz.

Sub test()
Sayfa1.Shapes("Rectangle 1").Height = Sayfa1.Shapes("Rectangle 1").Height + 1
End Sub