resim makro hata yardım

[bycakir]

merhabalar.
öncelikle konuyu kısaca anlatayım macro ve form uzerinden firmamda ki personel bilgilerini takıp ediyorum. form da sicil yazdığımda personelin bütün bilgilerini alıyorum. fakat yeni sorgu çalıştırdığımda eski resmi silip yenisi geliyor fakat sayfadaki makrolu butonların hepsinide siliyor.

sicil noyu yazdığımızda resim çıkıyordu. Tekrar yazdığımızda bir önceki resmi silip yeni sicil noya göre resim çıkıyordu. Ancak resmi silince sayfadaki makrolu butonlarıda siliyor bunu nasıl engelleriz.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [D3]) Is Nothing Then Exit Sub

'hata kontrolü
On Error GoTo çıkış


'Resimleri Sil

ActiveSheet.DrawingObjects.Delete (bu kırmızı kısma ne yazmalıyız ki sadece bir önceki resmi silsin ama diğer makrolu butonları silmesin. [ActiveSheet.Pictures.Delete] yazdım olmadı.)

'Resim yolunun bulunması

Dim ResimYolu As Variant
Dim Resim As Object

ResimYolu = "\\Share\revir$\PERSONEL_RESIMLERI\Güncel resimler (silinmeyecek)\" & Range("D3") & ".jpg"

'Resmi oluştur
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)

'Resmi boyutlandır

With Range("C5")
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With

If Intersect(Target, Range("D3")) Is Nothing Then Exit Sub

On Error Resume Next
With Target
If .Row < 1 Then Exit Sub
.Offset(1, 2) = ""
If .Value = "" Then Exit Sub
.Offset(0, 2) = Date

End With

çıkış:
End Sub

 

[muygun]

Merhaba;
Kodları kendinize uyarlayın.
İyi çalışmalar.

Sub resim_sil()
Set Alan = Range("B2:B2") 'Buraya resim adresini yazın.
For Each resimm In ActiveSheet.Pictures
If Not Intersect(resimm.TopLeftCell, Alan) Is Nothing Then
resimm.Delete
End If
Next
Set Alan = Nothing
End Sub

 

[bycakir]

teşekkürler deneyeceğim

 

[bycakir]

tekrar merhabalar kod hata verdi excell i aşağıya ekliyorum kontrol edip dogru yerleri düzeltirseniz sevinirim birde hangi satırları değiştirdiğinizi yazarsanız bende tekrar hataya meyil etmemiş olurum şimdiden teşekkürler.

 

[muygun]

Merhaba;
Kodları değiştirdim ve gerekli satırların yanına açıklama yazdım.
Eki deneyin.
İyi çalışmalar.

 

[bycakir]

teşekkürler