Korhan Hocam sayfa üzerine (Kare) bir şekil eklemiş. A1 ve B1 hücrelerinden girilen değerleri aldırmış. Yazdığı kod ise;
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1,B1]) Is Nothing Then Exit Sub 'Seçilen hücre A1 veya B1 değilse komutu çalıştırma.
ActiveSheet.Shapes("Rectangle 1").Select 'Sayfadaki şekli seç (Şeklin ismi Rectangle 1)
Selection.ShapeRange.Height = [B1] * 28.2 'Şeklin yüksekliği B1'e girilen değerin 28.2 ile çarpımıdır (Sanırım bu cm. e çevirmek için)
Selection.ShapeRange.Width = [A1] * 28.4 'Şeklin genişliği A1'e girilen değerin 28.4 ile çarpımıdır
[A1].Select 'A1 hücresini seç
End Sub
Aşağıdaki kodları bir butona bağlayınız.
Sub ayarla()
b = 38
say = ActiveSheet.Shapes.Count
For a = 1 To say - 1
ActiveSheet.Shapes(a).Select
Selection.ShapeRange.Height = Cells(b, 3) * 28.2
Selection.ShapeRange.Width = Cells(b, 2) * 28.4
b = b + 1
Next a
[A1].Select
End Sub
Not : Eğer şekiller büyük çıkıyor diyorsanız koddaki 28.2 ve 28.4 rakamlarını uygun şekilde küçültünüz. Örneğin ikisinide 12 yapın gibi.
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.