Çalışma sayfasına yüklenmiş resimlerin alt alta belli bir aralık payıyla sıralanmasını sağlayan alternatif bir VBA kodudur.
Option Explicit
Sub ResimleriAltAltaHizalaVeTumunuSec()
Dim i As Integer
Dim sekil_sayisi As Integer
Dim aralik_payi As Integer
Dim sekil As shape
Dim kumulatifYukseklik As Long
sekil_sayisi = ActiveSheet.Shapes.Count
aralik_payi = 5
kumulatifYukseklik = 0
For i = 1 To sekil_sayisi
'ActiveSheet.Shapes.Range(Array("Picture " & i)).Select
Set sekil = ActiveSheet.Shapes(i)
sekil.Select
If TypeName(Selection) = "Picture" Then
ActiveSheet.Shapes(sekil.Name).Select
Selection.Left = Range("A1").Left
Selection.Top = kumulatifYukseklik
kumulatifYukseklik = kumulatifYukseklik + sekil.Height + aralik_payi
End If
Next
ActiveSheet.Pictures.Select
End Sub
Option Explicit
Sub ResimleriAltAltaHizalaVeTumunuSec()
'--------------------------------------------------
'Değişkenler
'--------------------------------------------------
Dim i As Integer
Dim sekil_sayisi As Integer
Dim aralik_payi As Integer
Dim sekil As shape
Dim kumulatifYukseklik As Long
'--------------------------------------------------
'Çalışma sayfasında tüm Shape tipli
'öğelerin toplam sayısını buluyoruz.
'Bu döngü için işimize yarayacak.
'--------------------------------------------------
sekil_sayisi = ActiveSheet.Shapes.Count
'--------------------------------------------------
'Resimler alt alta eklenirken arada bırakılacak
'boşluk miktarını bu değişkenle belirliyoruz.
'--------------------------------------------------
aralik_payi = 5
'--------------------------------------------------
'Çalışma sayfasına yüklenmiş resimler aynı yüksekliğe
'sahip olabileceği gibi farklı yüksekliklere de sahip
'olabilir. Bu durumda sağlıklı bir dizilim yapabilmek
'için alt alta eklenmiş resimleri (eklenen boşlukla
'beraber) tek bir resimmiş gibi düşünüp bu toplam
'resmin yüksekliğini bulmamız gerekiyor. Tabii bu
'yükseklik de resim eklendikçe değişeceği için her
'seferinde yeniden hesaplanacak. Bunu da aşağıdaki
'döngü ile yaptıracağız.
'--------------------------------------------------
kumulatifYukseklik = 0
'--------------------------------------------------
'Çalışma sayfasındaki bütün şekiller için döngü çalıştır.
'--------------------------------------------------
For i = 1 To sekil_sayisi
'--------------------------------------------------
'Sıradaki Shape tipli öğeyi değişkene ata.
'--------------------------------------------------
Set sekil = ActiveSheet.Shapes(i)
'--------------------------------------------------
'Şekli seç.
'--------------------------------------------------
sekil.Select
'--------------------------------------------------
'Eğer seçilen öğenin tipi "Picture" ise işlem yap.
'--------------------------------------------------
If TypeName(Selection) = "Picture" Then
'--------------------------------------------------
'Şekli seç.
'--------------------------------------------------
ActiveSheet.Shapes(sekil.Name).Select
'--------------------------------------------------
'Resmin Left hizalamasını yapıyoruz.
'Yani resim ne solda olacak bunu belirliyoruz.
'Bu satırda Left bilgisi olarak hücrenin konum
'bilgisini referans verdik. Tabii A1 hücresinin
'Left değeri sıfır olduğundan dolayı resimler de
'sol kısımla sıfırlanacak şekilde alt alta sıralanacak.
'--------------------------------------------------
Selection.Left = Range("A1").Left
'--------------------------------------------------
'Şimdi de resmin ne kadar üstte duracağını belirliyoruz.
'İlk resim en üstte duracak.
'İkinci resim ilk resmin altında duracak.
'Üçüncü resim ikinci resmin altında duracak.
'...
'Bütün resimler alt alta dizilene kadar
'bu işlem bu şekilde devam edecek.
'--------------------------------------------------
Selection.Top = kumulatifYukseklik
'--------------------------------------------------
'Resmi ekledik. Şimdi yeni eklenecek resmin konumunu
'üstteki resme ya da resim grubuna göre yeniden
'hesaplamamız gerekiyor. Eğer ben resmin veya resim
'grubunun toplam yüksekliğini bilirsem, yeni eklenecek
'resmin nereye konumlandırılabileceğini bulurum.
'--------------------------------------------------
kumulatifYukseklik = kumulatifYukseklik + sekil.Height + aralik_payi
End If
Next
'--------------------------------------------------
'Bütün resimleri seç.
'Varsa şekliniz, tekrar bekleriz.
'--------------------------------------------------
ActiveSheet.Pictures.Select
End Sub