Nesneleri Silen Makro'da Düzenleme

[1Al2Ver]

Merhaba,

Aşağıdaki kod, sayfada kayıtlı nesneleri (Düğme, resim vb) siliyor,

Ben resimler dışındaki nesneleri silmesin istiyorum,

Kod'da gerekli düzenlemeyi rica ediyorum,

Teşekkür ederim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, [b1]) Is Nothing Then Exit Sub
On Error GoTo çıkış
[COLOR="Red"]ActiveSheet.DrawingObjects.Delete[/COLOR]
Dim ResimYolu As Variant
Dim Resim As Object

ResimYolu = ActiveWorkbook.Path & "\" & Range("B1") & ".jpg"
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)

With Range("B3")

Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width

End With
çıkış:
End Sub

 

[antonio]

If Intersect(Target, [b1]) Is Nothing Then Exit Sub
On Error GoTo çıkış

[COLOR="Blue"][B]For Each nesne In ActiveSheet.Shapes
    If nesne.Type <> 13 And nesne.Type <> 12 And nesne.Type <> 8  Then
        nesne.Delete
    End If
Next nesne[/B][/COLOR]

Dim ResimYolu As Variant
Dim Resim As Object

ResimYolu = ActiveWorkbook.Path & "\" & Range("B1") & ".jpg"
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)

With Range("B3")

Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width

 

[Asri]

If Intersect(Target, [b1]) Is Nothing Then Exit Sub
On Error GoTo çıkış

[COLOR=Blue][B]For Each nesne In ActiveSheet.Shapes
    If nesne.Type <> 13 Then
        nesne.Delete
    End If
Next nesne[/B][/COLOR]

Dim ResimYolu As Variant
Dim Resim As Object

ResimYolu = ActiveWorkbook.Path & "\" & Range("B1") & ".jpg"
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)

With Range("B3")

Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width

Bu koda 8 ve 12 de eklenir ise daha iyi olur diye düşünüyorum.

 

[antonio]

Bu koda 8 ve 12 de eklenir ise daha iyi olur diye düşünüyorum.

Asri Bey haklısınız. Kodu, belirttiğiniz şekilde düzelttim.

 

[1Al2Ver]

Sayın antonio merhaba,

Geç dönüş yaptığım için kusuruma bakmayın, soğuk algınlığı nedeniyle bilgisayarın başına yeni geçebildim,

Kod gayet güzel çalışıyor, emekleriniz için teşekkür ederim.

Saygılarımla.

 

[1Al2Ver]

Sayın asri merhaba,

Katkılarınız için teşekkür ederim.

Saygılarımla.

 

[antonio]

Geçmiş olsun. Sağlıklı günler dilerim.

 

[Asri]

Sayın antonio merhaba,

Geç dönüş yaptığım için kusuruma bakmayın, soğuk algınlığı nedeniyle bilgisayarın başına yeni geçebildim,

Kod gayet güzel çalışıyor, emekleriniz için teşekkür ederim.

Saygılarımla.

Geçmiş olsun, iyi çalışmalar.