Resimleri Alt Alta Hizala Ve Tümünü Seç - Microsoft Excel


Çalışma sayfasına yüklenmiş resimlerin alt alta belli bir aralık payıyla sıralanmasını sağlayan alternatif bir VBA kodudur.

Kod


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

Kod (Açıklamalı)


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

Yararlanılan Kaynaklar
Etiketler
microsoft excel açıklamalı içerik microsoft excel vba