Ürüne Ait Resmi Silme.

[ILHAREFF]

Merhaba arkadaşlar,
D sütüne yazmış olduğum ürün isimlerine göre resimleri getiriyorum burda bir sıkıntım yok, fakat ürünlerin arasından bir ürünü sildiğim de sadece o ürünün resminin silinmesini istiyorum 'ActiveSheet.DrawingObjects.Delete deniyorum bütün resimleri siliyor. Bu konuyla ilgili yardımlarınızı rica ediyorum. Şimdiden teşekkürler ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
If Target.Row Mod 20 = 0 Then Exit Sub
On Error GoTo son
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".png").Select
Selection.Top = Target.Offset(0, 2).Top + 5
Selection.Left = Target.Offset(0, 4).Left + 25
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 2).Height - 10
Selection.ShapeRange.Width = Target.Offset(0, 4).Width - 60
Target.Offset(1, 0).Select
son:
End Sub

 

[halit3]

kodunuzun bölümüne kırmızı yeri ekleyin

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
If Target.Row Mod 20 = 0 Then Exit Sub
On Error GoTo son
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".png").Select
Selection.Top = Target.Offset(0, 2).Top + 5
Selection.Left = Target.Offset(0, 4).Left + 25
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 2).Height - 10
Selection.ShapeRange.Width = Target.Offset(0, 4).Width - 60
[COLOR="Red"]Selection.Name = Target.Value[/COLOR]

Target.Offset(1, 0).Select
son:
End Sub

Buradan yola çıkarak nesnenizin bir adı oldu şimdide bu kod ile aranan nesne adını yaz ve tamamı tıkla.

Sub Nesneleri_sil()

aranan = InputBox("Aranan resimin adını yazınız.", "Arama Penceresi", "")
 
If aranan = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If

Dim Picture As Object
For Each Picture In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
If aranan = Picture.Name Then
Picture.Delete
End If
End If

Next Picture

End Sub