Sayfaya Resim eklerken resimlerin boyuta göre konumlandırılması

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,059
Excel Vers. ve Dili
Office 2013 İngilizce
mehaba,
Aşağıdaki kod ile bir klasör içindeki tüm png görselleri excel sayfasına almaya çalışıyorum, resimler excel sayfasına geldiği zaman görsel boyutları farklı olduğu için üst üste çakışmalar, yada arada boşluklar olabiliyor. Burada benim istediğim önceki görselin bittiği yerden bir sonraki görsel gelsin.
bun durumu nasıl ayarlayabiliriz? yani üst üste çakışma yada arada boşluklar olmasın (iki resim arasında standart çok az bir boşluk olabilir)

resim.Top = Cells(x, 2).Top
resim.Left = Cells(x, 2).Left


bu kısmda nasıl bir düzenleme yapmak geekir?


Kod:
Sub test()
Dim i As String
Dim yol As String

Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File

yol = ThisWorkbook.Path & "\Gorsel"
Set fo = fso.GetFolder(yol)

i = 3

For Each f In fo.Files

pName = f.Name

    If LCase(Right(pName, 4)) = ".png" Then

         sFileName = yol & "\" & pName

        sh.Range("H" & i).Value = pName
        
        Call InsertImage(sFileName, i - 2)
        
        sFileName = ""

    i = i + 1

    End If

Next
Kod:
End Sub

Private Sub InsertImage(resimyolu As String, Sira As Integer)
Dim resim
Dim x As Integer

On Error Resume Next

x = Sira * 10

Set fso = VBA.CreateObject("scripting.filesystemobject")


If fso.FileExists(resimyolu) Then


  Set resim = ActiveSheet.Pictures.Insert(resimyolu)
    
   resim.Top = Cells(x, 2).Top
   resim.Left = Cells(x, 2).Left
   resim.ShapeRange.LockAspectRatio = msoFalse
  
End If

End Sub
 
Üst