Klasorde resmi olmayanı geçme

[Grimm80]

Merhabalar

2000 satırlık bir excel dosyam var ve bir klasorde bunların bir kısmının resimleri var aşağıdaki gibi bir makro kodum var. Ama bu kodda resim yoksa diğer satırların resimleri getirmeden hata veriyor Benim istediğim ürün kodunun resmi yok ise aynı isimli oraya noimage yazılı resmi getirmesini istiyorum ki liste hata vermeden tamamlansın ( noimage.jpg klasörde bu şekilde resmim var )


Sub UFUKK()
Dim a As Integer
Dim son As Integer
Dim ad As String
Dim yol As String

yol = "C:\buyukresim\"
son = Range("A" & Rows.Count).End(xlUp).Row
For a = 1 To son
ad = yol & Cells(a, 1) & ".jpg"
With ActiveSheet.Pictures.Insert(ad)
.Left = Cells(a, 2).Left
.Top = Cells(a, 2).Top
.ShapeRange.LockAspectRatio = True
.ShapeRange.Height = 100
End With
Rows(a).RowHeight = 100
Next a
MsgBox "İşlem tamamlandı", vbInformation, "T A M A M"
End Sub



Şimdiden tşk. ederim

 

[Emir Hüseyin Çoban]

. . .

Sub UFUKK()
    Dim a As Integer
    Dim son As Integer
    Dim ad As String
    Dim yol As String
    
    yol = "C:\buyukresim\"
    son = Range("A" & Rows.Count).End(xlUp).Row
    For a = 1 To son
        ad = yol & Cells(a, 1) & ".jpg"
        
        If Dir(ad) = "" Then
            With ActiveSheet.Pictures.Insert(yol & "noimage.jpg")
                .Left = Cells(a, 2).Left
                .Top = Cells(a, 2).Top
                .ShapeRange.LockAspectRatio = True
                .ShapeRange.Height = 100
            End With
        Else
            With ActiveSheet.Pictures.Insert(ad)
                .Left = Cells(a, 2).Left
                .Top = Cells(a, 2).Top
                .ShapeRange.LockAspectRatio = True
                .ShapeRange.Height = 100
            End With
        End If
        
        Rows(a).RowHeight = 100
    Next a
    MsgBox "İşlem tamamlandı", vbInformation, "T A M A M"
End Sub

. . .

 

[Grimm80]

İlginiz için çok tşk. ederim .

Kod çalışıyor 10 üründe denediğim zaman bir sıkıntı yok fakat 2000 üründe 20 dkdır sayfa yanıt vermiyor bu normal mi yada hızlandırıcı bir kod varmı acaba yoksa da artık bekliyecem yine de ilginiz için tşk. ederim