Çözüldü Resim Silme

Aşağıdaki Makro ile; Başka bir dosyadan personel ismine göre sayfaya resim getiriyorum Buraya kadar sorun yok
Yalnız; Sayfada başka bir resim varsa makro çalıştığı zaman sayfadaki bu resimleri de siliyor.
Ve, her personel ismini değiştirdiğimde, kaydetmek gerekiyor, kaydetmezsem makro ikinci kez çalışmıyor.
Yardımlarınız için şimdiden teşekkür ediyorum. İyi çalışmalar.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim resim As Shape, resimyolu As String
Dim evn As Object, klasor As Object, res As Object
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.getfolder(ThisWorkbook.Path & "\PERSONEL_RESİMLERİ")
For Each resim In ActiveSheet.Shapes
resim.Delete
Next
For Each res In klasor.Files
If res.Name = Range("b2").Value & ".jpg" Then
resimyolu = ThisWorkbook.Path & "\PERSONEL_RESİMLERİ\" & res.Name
Range("H2").Select
ActiveSheet.Pictures.Insert(resimyolu).Select
With Selection.ShapeRange
.ScaleWidth 1.2, 0, 0
.ScaleHeight 1.01, 0, 0
End With
End If
Next res
Range("b3").Select
Set evn = Nothing
Set klasor = Nothing
Set res = Nothing
Set resim = Nothing
resimyolu = vbNullString
End Sub

Sanırım iki şeyi yanlış yaptım1: Soru bölümünde açmam gerekiyordu 2 Başlığı; Resim Silme yazacakken, Resim Silem diye yazmışım. Özür.

Merhaba;

kodlardaki;

For Each resim In ActiveSheet.Shapes
resim.Delete
Next

kısmının yerine;

Set Alan = Range("a6:ac57")
For Each resimm In ActiveSheet.Pictures
If Not Intersect(resimm.TopLeftCell, Alan) Is Nothing Then
resimm.Delete
End If
Next
Set Alan = Nothing

Kodlarını uygulayarak deneyin.
Set Alan = Range("a6:ac57") kısmındaki a6:ac57 aralığını (resim varsa silinecek alan) kendinize göre düzenleyin.

İyi çalışmalar.i

muygun' Alıntı:

Merhaba;

kodlardaki;

For Each resim In ActiveSheet.Shapes
resim.Delete
Next

kısmının yerine;

Set Alan = Range("a6:ac57")
For Each resimm In ActiveSheet.Pictures
If Not Intersect(resimm.TopLeftCell, Alan) Is Nothing Then
resimm.Delete
End If
Next
Set Alan = Nothing

Kodlarını uygulayarak deneyin.
Set Alan = Range("a6:ac57") kısmındaki a6:ac57 aralığını (resim varsa silinecek alan) kendinize göre düzenleyin.

İyi çalışmalar.i

Genişletmek için tıkla ...

Çok Teşekkürler