Aranan resim yok ise Resim_Yok.Jpg gelsin

[tahsinanarat]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:J65536]) Is Nothing Then Exit Sub
If Target.Row Mod 43 = 0 Then Exit Sub
On Error GoTo Hata
For i = 1 To Sheets("TABLO").Shapes.Count
If Sheets("TABLO").Shapes(i).Left = Target.Offset(-1, 0).Left _
And Sheets("TABLO").Shapes(i).Top = Target.Offset(-1, 0).Top Then
Sheets("TABLO").Shapes(i).Delete
End If
Next i
Hata:
On Error GoTo son
Sheets("TABLO").Pictures.Insert("D:\A Grubu Personel resimleri\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(-1, 0).Top
Selection.Left = Target.Offset(-1, 0).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 3 'Sağa kaydır
Selection.ShapeRange.IncrementTop 2.25 'aşağıya kaydır
'Selection.ShapeRange.Height = Target.Offset(-1, 0).Height
'Selection.ShapeRange.Width = Target.Offset(-1, 0).Width
Selection.ShapeRange.Height = 109
Selection.ShapeRange.Width = 94
'Target.Select
son:
End Sub


Yukarıdaki kod ile hücreye isim yazınca dosya yolundaki resimlerden eşleşenler bir üst hücreye getirebiliyoruz, eğer aranan resim yok ise Resim_yok.jpg adlı resmin gelmesi için kodda nasıl bir değişiklik yapmalıyız.
Yardımlarınız için şimdiden teşekkür ederim. Tahsin.

 

[Orion1]

şöyle denenyiniz.

if dir("D:\A Grubu Personel resimleri\" & Target.Value & ".jpg") <> "" then _
Sheets("TABLO").Pictures.Insert("D:\A Grubu Personel resimleri\" & Target.Value & ".jpg").Select
else
Sheets("TABLO").Pictures.Insert("D:\A Grubu Personel resimleri\" & resim_yok & ".Jpg").select
end if

 

[tahsinanarat]

Hocam ilginize çok teşekkür ediyorum, ancak uygulamada else nin üzerine gelip makro duruyor.

 

[Orion1]

Hocam ilginize çok teşekkür ediyorum, ancak uygulamada else nin üzerine gelip makro duruyor.

örnek yollayabilirmisiniz?

 

[tahsinanarat]

örnek tabloyu ekte gönderiyorum.

Hocam tablo ektedir. Resimler isimler ile eşleşiyor, eğer yazılı isme ait resim klasörde yok ise Resim_yok.jpg adlı resmi getirmeye çalışıyorum. Normalde kodlar resim olanları getirmektedir.

 

[Skorpiyon]

Denemedim ama, aşağıdaki şekilde bir bakar mısınız.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:J65536]) Is Nothing Then Exit Sub
If Target.Row Mod 43 = 0 Then Exit Sub
On Error GoTo Hata
For i = 1 To Sheets("TABLO").Shapes.Count
If Sheets("TABLO").Shapes(i).Left = Target.Offset(-1, 0).Left _
And Sheets("TABLO").Shapes(i).Top = Target.Offset(-1, 0).Top Then
Sheets("TABLO").Shapes(i).Delete
End If
Next i
Hata:
On Error GoTo son
Sheets("TABLO").Pictures.Insert("D:\A Grubu Personel resimleri\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(-1, 0).Top
Selection.Left = Target.Offset(-1, 0).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 3 'Sağa kaydır
Selection.ShapeRange.IncrementTop 2.25 'aşağıya kaydır
'Selection.ShapeRange.Height = Target.Offset(-1, 0).Height
'Selection.ShapeRange.Width = Target.Offset(-1, 0).Width
Selection.ShapeRange.Height = 109
Selection.ShapeRange.Width = 94
'Target.Select
GoTo 10
son:
Sheets("TABLO").Pictures.Insert("D:\A Grubu Personel resimleri\" & Resim_yok & ".jpg").Select
Selection.Top = Target.Offset(-1, 0).Top
Selection.Left = Target.Offset(-1, 0).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 3
Selection.ShapeRange.IncrementTop 2.25
10
End Sub

 

[Orion1]

Dosyanız ektedir.
Yoksa çarpı şekli getiriyor.
Yalnız benim yazdığım yolu kendinize göre değişitiriniz.
Dosyanız ektedir.

 

[tahsinanarat]

Sn. orion1 hocam sizleri bayağı bir yordum, hakkınızı helal edin. Tam istediğim gibi oldu, elinize yüreğinize sağlık. Çok teşekkür ediyorum. Saygılar Tahsin
Sn.Skorpiyon sizin kodları da denedim hata veriyor ancak ayrıca yine inceleyeceğim. Sizede çok teşekkür ederim.

 

[Skorpiyon]

Mantık şu idi,

Eğer hücredeki değer ile ilgili bir resim bulunamazsa (on error goto son) satırı ile son isimli satıra yönlendirme yapılıyordu. Eğer resim yok ise son'a git ve resim_yok.jpg 'i yükle dedim. (Resmin yolunu ve adını kontrol ediniz, hata orada olabilir)
Eğer hücredeki değer ile ilgili bir resim bulunursa, resim gösterilecek ve son 'un üzerindeki goto 10 ile atlatma yaptırılarak makro sonlandırılacaktı.

Kolay gelsin.