Yalnız Mesajı Göster
Eski 09-02-2018, 10:25  
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,965
Excel Vers. ve Dili:
2010-2016
Varsayılan

Aşağıdaki kodları bir modüle yapıştırıp deneyin. Belirttiğiniz formatta değil de resim isimleri 01-02 şeklinde gittiğiniz varsayarak kod yazdım.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub askm()
Call Belirli_Bir_Alandaki_Resimleri_Sil
Klasor = ThisWorkbook.Path & "\"
On Error Resume Next
Satir = 52
For i = 1 To 6
    If i < 10 Then
        dosya = Klasor & "0" & i & ".jpg"
    Else
        dosya = Klasor & i & ".jpg"
    End If
    Range(Cells(Satir, 2), Cells(Satir + 46, "Y")).Select
    Range(Cells(Satir, 2), Cells(Satir + 46, "Y")).Merge
    ActiveSheet.Pictures.Insert(dosya).Select
    With Selection
            .ShapeRange.LockAspectRatio = msoFalse
            .Top = Range(Cells(Satir, 2), Cells(Satir + 46, "Y")).Top
            .Left = Range(Cells(Satir, 2), Cells(Satir + 46, "Y")).Left
            .Width = Range(Cells(Satir, 2), Cells(Satir + 46, "Y")).Width
            .Height = Range(Cells(Satir, 2), Cells(Satir + 46, "Y")).Height
    End With
    Satir = Satir + 50
Next i
End Sub


Sub Belirli_Bir_Alandaki_Resimleri_Sil()
    Dim Resim As Picture, Alan As Range
    Set Alan = Range("B52:Y65536")
    For Each Resim In ActiveSheet.Pictures
        If Not Intersect(Resim.TopLeftCell, Alan) Is Nothing Then
            Resim.Delete
        End If
    Next
    Set Alan = Nothing
End Sub
__________________
excel 2010- türkçe
askm Çevrimiçi   Alıntı Yaparak Cevapla