Nesne boyutlandırma (Orta hizalı)

[tayfun.tk]

Belirlediğim hücrede ki değere göre nesneyi boyutlandırıyorum ancak ufak bir çözüme ihtiyacım var.

Aşağıdaki kodda "Oval 1" nesnesinin yükseklik ve genişliğini AR7 hücresinde ki değere göre şekillendiriyorum ancak boyutlandırma ortalı olmuyor, sola hizalı boyutlanma oluyor. Benim istediğim ilgili görsel excel in içinde nerede ise bulunduğu yerde ortalı boyutlanması. Bu konuda yardıma ihtiyacım var, desteklerinizi rica ediyorum..

ActiveSheet.Shapes("Oval 1").Height = [AR7].Value
ActiveSheet.Shapes("Oval 1").Width = [AR7].Value

Teşekkürler

 

[askm]

Aşağıdaki linki inceleyiniz.

[SOLVED:] Align all shapes to the center of their cell

Hy, I try to align all shapes in my workbook to the center of their respective cell. I found a solution to align one selected shape and I know how to select all shapes of a workbook. But I don't get how to align all selected shapes. That is the solution for aligning one selected...

www.vbaexpress.com

 

[tayfun.tk]

Aşağıdaki linki inceleyiniz.

[SOLVED:] Align all shapes to the center of their cell

Hy, I try to align all shapes in my workbook to the center of their respective cell. I found a solution to align one selected shape and I know how to select all shapes of a workbook. But I don't get how to align all selected shapes. That is the solution for aligning one selected...

www.vbaexpress.com

Maalesef aradığım cevabı bulamadım. Yalnızca seçmiş olduğum nesneyi bir üstünde ki hücreye göre ortalıyor.

Şöyle ki dosyamda Oval 1 2 3 4 5 diye 100 e yakın nesne var, bu nesneler belirli bir düzene göre dosyanın çeşitli yerlerine dağıttım. Dağıttığım yerlerde sabit kalmalı ve boyutunu değiştirdiğim zaman merkezden büyümeli ya da küçülmeli, öyle bir şey arıyorum..

 

[Korhan Ayhan]

Kendinize uyarlarsınız.

Option Explicit

Sub Test()
    Dim Nesne As Shape
    
    For Each Nesne In ActiveSheet.Shapes
        If InStr(1, Nesne.Name, "Oval") Then
            With Nesne
                .Height = [AR7].Value
                .Width = [AR7].Value
                .Left = .TopLeftCell.Left + .TopLeftCell.Width / 2 - .Width / 2
                .Top = .TopLeftCell.Top + .TopLeftCell.Height / 2 - .Height / 2
            End With
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tayfun.tk]

Kendinize uyarlarsınız.

Option Explicit

Sub Test()
    Dim Nesne As Shape
   
    For Each Nesne In ActiveSheet.Shapes
        If InStr(1, Nesne.Name, "Oval") Then
            With Nesne
                .Height = [AR7].Value
                .Width = [AR7].Value
                .Left = .TopLeftCell.Left + .TopLeftCell.Width / 2 - .Width / 2
                .Top = .TopLeftCell.Top + .TopLeftCell.Height / 2 - .Height / 2
            End With
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Yanıtınız için teşekkürler, ancak yine en yakın hücreyi ortalayıp kaydırıyor ve öyle boyutlandırıyor, bir de kodu her çalıştırdığımda sol üst köşeye gidiyor şekiller, bunlar için bir çözüm bulabilir miyiz?

 

[Korhan Ayhan]

Bu durumda örnek dosya paylaşıp talebinizi tarif ediniz.

 

[mfgo@hotmail.com]

Selamunaleyküm Kolay gelsin hocalar ve değerli Excel dostları
frmGuncelle.Top = 30 + lstOgrenciler.ListIndex * 12
ekteki dosyada listboxta veri fazla olunca kaydırma çubuğunu aşağıya indirince yukarıdaki kod işlemini görmüyor
nasıl bir kod yazmam lazım.
vakti olupta bakandan allah razı olsun