Soru Ürün Koduna Göre Resim Getirmek

[bulentkars]

Arkadaşlar Merhaba,

"A7" Hücresine Ürün kodu girdiğimde C:\Resimler\1234.jpg dosyasının gelmesini istiyorum.
sürekli a7 hüsresine ürün kodu girdiğimde ilgili ürün kodunu C:\Resimler\ klasöründen gelmesini istiyorum.
Örnek Dosya ekte yardımcı olabilirseniz sevinirim. Şİmdiden teşkkürler

 

[Korhan Ayhan]

Merhaba,

Sayfanızın kod bölümüne uygulayıp deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Resim As Object, Alan As Range, Yol As String
    
    Application.ScreenUpdating = False
    
    Yol = "C:\Resimler\"
   
    Set Alan = Range("C9:C26")
   
    For Each Resim In ActiveSheet.Pictures
        If Not Intersect(Resim.TopLeftCell, Alan) Is Nothing Then
            Resim.Delete
        End If
    Next
   
    Alan.Cells(1, 1).Select
   
    If Dir(Yol & Target.Value & ".jpg") <> "" Then
        Set Resim = ActiveSheet.Pictures.Insert(Yol & Target.Value & ".jpg")
        
        With Resim
            .ShapeRange.LockAspectRatio = msoFalse
            .Top = Alan.Top
            .Height = Alan.Height
            .Width = Alan.Width
        End With
    Else
        MsgBox "Resim bulunamadı!", vbCritical
    End If
   
    Target.Select
   
    Set Alan = Nothing
    Set Resim = Nothing
        
    Application.ScreenUpdating = True
End Sub

 

[bulentkars]

Korhan Bey,

Çok Teşekkür ederim elinize sağlık tam istediğim gibi olmuş. A7 hücresine user form aracılığı ile müşteri adını seçip entere bastığımda kodu a7 ye yazıyor ancak. resim bulunamadı yazıyor. hüsreye manuel resim kodu girdiğimde geliyor. user form üzerinden müşteri seçip entere bastığımda a7 satırına ürün kodunu yazıyor ve ürün bulunamadı yazıyor ne yapmam gerekiyor acaba

 

[bulentkars]

Korhan Bey,

tamamdır. Düzeldi. Çok çok teşekkür ederim. emeğinize sağlık

 

[YUSUF44]

Affınıza sığınarak bir sitemde bulunmak istiyorum. Her ne kadar sorun çözülmüş olsa da ilk mesajınızda userformla ilgili bir şey yokken ve hatta "tam istediğiniz gibi" bir çözüm sunulmuşken "userformda bu işlem olmuyor" diye tamamen yeni bir konuya geçmeniz hoş bir durum oluşturmuyor. Sanki Korhan üstadımız çözümü eksik yapmış gibi anlaşılıyor. Halbuki "userformda olmuyor" yerine "peki bunu userforma şu işlem yapılırken nasıl olur?" diye belirtseniz daha şık olur diye düşünüyorum.

 

[bulentkars]

Affınıza sığınarak bir sitemde bulunmak istiyorum. Her ne kadar sorun çözülmüş olsa da ilk mesajınızda userformla ilgili bir şey yokken ve hatta "tam istediğiniz gibi" bir çözüm sunulmuşken "userformda bu işlem olmuyor" diye tamamen yeni bir konuya geçmeniz hoş bir durum oluşturmuyor. Sanki Korhan üstadımız çözümü eksik yapmış gibi anlaşılıyor. Halbuki "userformda olmuyor" yerine "peki bunu userforma şu işlem yapılırken nasıl olur?" diye belirtseniz daha şık olur diye düşünüyorum.

Uyarınız için çok teşekkür ederim Yusuf beyi dikkatli olurum inşallah

 

[bulentkars]

Korhan Bey Merhaba,

Ürün kodunu yeniledikçe eski resimler temizenmediğini farkettim, elimde daha önce kullandığım kod üzerinden yapmak istedim olmadı, mümkünse eğer ürün kodunu yazdıkça önceki resmin temizlenmesi için yardımcı olabilirseniz sevinirim.

Sub Resim_Sil()
Dim Resim
For Each Resim In ActiveSheet.Shapes
If Resim.Name = "Resim 1" Then Resim.Delete
Next
End Sub

 

[Korhan Ayhan]

Merhaba Bülent Bey,

Kodun içinde silme kodu zaten var. Aşağıdaki hücre aralığına göre resim siliniyor. Eğer eklenen resmin TOP ve LEFT değeri hücrenin sınırını aşıyorsa sorun olabilir. Eklenen resmi bu alan içine mouse ile yerleştirdikten sonra A7 hücresine yeni veri girip sonucu gözlemleyiniz. Eğer durum bahsettiğim gibiyse resmi boyutlandıran bölüme küçük ilaveler yapmak gerekecektir.

Set Alan = Range("C9:C26")

 

[bulentkars]

Korhan Bey,
Tamamdır, dediğiniz gibi TOP-LEFT ayarları ile oynadım düzeldi. çok teşekkür ederim