Şekilleri Hizalamak

[toglyy]

Merhaba,

Ekle > şekiller menüsünden alt alta birkaç şekil ekledim (hepsi birbirinin aynısı) fakat hepsini bir kerede hizalayamıyorum, 100'den fazla satır var ve hepsini tek tek manuel olarak yapmak zorundayım gibi duruyor. Pratik bir yolunu bulamadım ama var mıdır?

 

[recepkull]

Ben şöyle bir şey düşündüm belki sitedeki ustalar daha pratik yol bulabilirler.

Şekillerin ismi Dikdörtgen 1, Dikdörtgen 2, Dikdörtgen 3..... diye sıralandığını varsaydım buna göre aşağıdaki kodu yazdım.

Hangi şeklin hizalanmasını istiyorsanız H1 hücresine o şeklin numarasına girin ve butona basın. Şekiller aynı boyutta B sütununa alt alta sıralanacaktır. Farklı bir sütuna sıralanmasını istiyorsanız koddaki With Range("B" & [H1]) satırını kendinize göre değiştirin.

Not: Şekillerin ismi Dikdörtgen değilse koddaki şekil ismini kendinize göre değiştirin.

Örnek dosyayı inceleyebilirsiniz.

Sub Makro1()
    ActiveSheet.Shapes.Range(Array("Dikdörtgen " & [H1])).Select
    With Range("B" & [H1])

    ActiveSheet.Shapes.Range(Array("Dikdörtgen " & [H1])).Left = .Left
    ActiveSheet.Shapes.Range(Array("Dikdörtgen " & [H1])).Top = .Top
    ActiveSheet.Shapes.Range(Array("Dikdörtgen " & [H1])).Height = .Height
    ActiveSheet.Shapes.Range(Array("Dikdörtgen " & [H1])).Width = .Width
    End With

End Sub

İNDİRME LİNKİ

 

[Seyit Tiken]

Tüm şekilleri seçin > Biçim > Hizalayı tıklayın > orada uygun seçeneğini seçiniz.

 

[toglyy]

@recepkull hocam henüz deneyemeden alttaki pratik yolunu gördüm, yinede çok teşekkür ederim ilgin için.

@Seyit Tiken hocam çok teşekkür ederim oldu, çok da iyi oldu bu pratik yolu öğrendiğim.

 

[toglyy]

tekrar merhaba,

bu şekilleri istediğim gibi sağa ve sola hizalayabiliyorum fakat şekillerin arasındaki boşluğu otomatik olarak ayarlayamadım, alt alta yüzlerce şekil eklemek gerekiyor ve (sepete ekle butonu) ve düzenli görünmesi için "ekle" butonlarının arasındaki boşluğu tek hamlede standart yapmak istiyorum

yardımcı olabilir misiniz?

 

[EmrExcel16]

tekrar merhaba,

bu şekilleri istediğim gibi sağa ve sola hizalayabiliyorum fakat şekillerin arasındaki boşluğu otomatik olarak ayarlayamadım, alt alta yüzlerce şekil eklemek gerekiyor ve (sepete ekle butonu) ve düzenli görünmesi için "ekle" butonlarının arasındaki boşluğu tek hamlede standart yapmak istiyorum

yardımcı olabilir misiniz?

Merhaba , bir dosya hazırladım deneyin, belki işinize yarar.

Sub Sekil_Dizayn()
    Dim satir, bosluk
    satir = Range("H1")
    bosluk = Range("H2")
    For Each shp In ActiveSheet.Shapes
        If shp.Name <> "Button 1" Then
            With Range("B" & satir)
                ActiveSheet.Shapes(shp.Name).Left = .Left
                ActiveSheet.Shapes(shp.Name).Top = .Top + bosluk
                ActiveSheet.Shapes(shp.Name).Height = .Height - (bosluk * 2)
                ActiveSheet.Shapes(shp.Name).Width = .Width
            End With
            satir = satir + 1
        End If
    Next
End Sub

 

[toglyy]

@EmrExcel16 hocam çok teşekkürler.

 

[EmrExcel16]

@EmrExcel16 hocam çok teşekkürler.

Rica ederim , iyi çalışmalar .