Verilen veriyle şekilin boyutunu ayarlamak?

[iMorningstar]

Merhaba excel'e yeniyim biraz, mesela elimde bir kare var, uzunluk h diyelim eni w, ben yazı olarak h'ye bir değer atadığım zaman mesela 15 diyeyim w'ye 8, bu değerlerin şekilede geçmesini, daha doğrusu şekilin uzayıp kısalmasını, genişlemesini istiyorum.
Böyle bir şey mümkün müdür acaba?

 

[yanginci34]

Öncelikle a1 e ve b1 e ölçekleri yazınız ve şeklin üzerine birkere tıklayınız sonra düğmeye basarak denermisiniz.
http://dosya.co/aunw11tq3hgf/şekil_ölçeği.xlsm.html

 

[iMorningstar]

Öncelikle a1 e ve b1 e ölçekleri yazınız ve şeklin üzerine birkere tıklayınız sonra düğmeye basarak denermisiniz.
http://dosya.co/aunw11tq3hgf/şekil_ölçeği.xlsm.html

Hocam teşekkür ederim, fakat buttona bastığımda Run-time error '438': Object doesn't support this property or method diye bir hata alıyorum.

Edit: Tamam hocam anladım şekli seçip basmak lazımmış buttona

 

[CelikBey]

Kodu indirdim. Gayet güzel çalışıyor. Elinize sağık.
Ben de iMorningstar'ın işini kolaylaştıracak birşey buldum şimdi.

Sn. iMorningstar eğer dikdörtgeni seçmeden bu işi daha seri yapmak istiyorsanız ilgili makroda ilk satırdaki şu kodun:

Selection.ShapeRange.Height = Range("a1")

üstüne şu satırı:

ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select

kopyalayıp yapıştırın. Ölçüleri girdikten sonra Düğmeye bastığınızda şekli seçmeden girdiğiniz ölçülere gelecektir.

 

[iMorningstar]

Kodu indirdim. Gayet güzel çalışıyor. Elinize sağık.
Ben de iMorningstar'ın işini kolaylaştıracak birşey buldum şimdi.

Sn. iMorningstar eğer dikdörtgeni seçmeden bu işi daha seri yapmak istiyorsanız ilgili makroda ilk satırdaki şu kodun:

Selection.ShapeRange.Height = Range("a1")

üstüne şu satırı:

ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select

kopyalayıp yapıştırın. Ölçüleri girdikten sonra Düğmeye bastığınızda şekli seçmeden girdiğiniz ölçülere gelecektir.

Çok teşekkür ediyorum Kod işime yaradı. Peki butona gerek kalmadan sadece yazarak şeklin boyutuyla oynamak mümkün müdür?

 

[Merhum İdris SERDAR]

.

Sayfanın Kod bölümüne aşağıdaki kodları yazın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim drtgn As Shape

Set drtgn = Sheets("Sheet1").Shapes("Rectangle 1")

With Sheets("Sheet1")
    If .Range("C3") <> "" Then drtgn.Width = .Range("C3") * 29.5
    If .Range("C4") <> "" Then drtgn.Height = .Range("C4") * 29.5
    
    
End With
   
     
End Sub

C3 ve C4 hücrelerine boyutları yazarak deneyin.


.

 

[iMorningstar]

.

Sayfanın Kod bölümüne aşağıdaki kodları yazın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim drtgn As Shape

Set drtgn = Sheets("Sheet1").Shapes("Rectangle 1")

With Sheets("Sheet1")
    If .Range("C3") <> "" Then drtgn.Width = .Range("C3") * 29.5
    If .Range("C4") <> "" Then drtgn.Height = .Range("C4") * 29.5
    
    
End With
   
     
End Sub

C3 ve C4 hücrelerine boyutları yazarak deneyin.


.

Teşekkür ediyorum, sanırım benden öncede biri böyle bir şey sormuş aynı kodu vermişsiniz. İşime yaradı cidden bu kadar hızlı cevap alabileceğimi düşünmüyordum bu forumda
Hocam bir sualim olsun size yeni başladım excel kullanmaya, verdiğiniz koddaki "drtgn" ne demek dikdörtgen mi? Birde şu sondaki neden *29.5, *10 olsa daha ortalama olmaz mı. Dediğim gibi yeniyim bazı şeyleri öğrenmeye çalışıyorum

 

[dellerlim]

Merhaba, İdris Bey daha doğrusunu bilir ama ben bildiğim kadarıyla yazayım; "drtgn" herhangi bir tanımlama siz istediğiniz başka bir değeri de yazabilirsiniz yani. *29,5 de sanıyorum farazi yazılmış dediğiniz gibi *10 da yazılabilir aslında. İlk satırda yazan Private Sub Worksheet_SelectionChange(ByVal Target As Range) kodlar ise sayfada değişiklik yapıldığında altında yazan kodların çalıştırılacağını ifade ediyor, butona bağlanmış işlevlerin ilk satırı yerine burada yazılanları yazdığınızda buton ile çalışan şeyler sayfada herhangi bir değişiklik yapıldığında çalışacaktır.(Tüm kodlar için [mesela sayfalar arası bazı işlemler] bu gerçekleşmeyebilir ama)