Onay Kutusu İşaretlenince Klasörden Resim Çağırmak

[ercan_bora]

Selamlar,

Aslında bu yazı
http://www.excel.web.tr/f48/klasorden-resim-getirmek-t172082.html
burada mevcut fakat tek resim üzerine ve projeye uyarlamayamadığm için böyle yayınlıyorum.

Resim/Picture yanındaki onay kutusuna basınca ürün koduna göre klasör içindeki resimler ilgili (turuncu renkli) yerlere gelecek.

Umarım böyle bişey mümkündür.

Çalışma dosyası burada.
http://s7.dosya.tc/server5/g10pa7/InvoiceCalisma.rar.html

Premium hesabım yok o yüzden buradan yüklüyorum.

Yardımlarınız için çok teşekkür ederim.

Saygılar

 

[muygun]

Merhaba;
Excel dosyası UrunResim klasörünün yanında olsun (içinde değil)
İnceleyin.
İyi çalışmalar.

Link:
http://s3.dosya.tc/server15/po0s5z/ercan_bora-Onay_Kutusu_ile_rsm_getir.zip.html

 

[Orion1]

Dosyanız ektedir.

Dosya Linki:
DOSYAYI İNDİR

Sub resimgetir59()
Dim resim, i As Long, sonsat As Long, resimad As String
For Each resim In ActiveSheet.Shapes
    If Left(resim.Name, 3) = "Pic" Then resim.Delete
Next
sonsat = WorksheetFunction.Count(Range("B7:B" & Rows.Count))
If sonsat < 1 Then Exit Sub
sonsat = sonsat + 6
For i = 7 To sonsat
    resimad = Cells(i, "D").Value & ".jpg"
    Set resim = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\UrunResim\" & resimad)
    resim.ShapeRange.LockAspectRatio = msoFalse
    resim.Left = Range("C" & i).Left
    resim.Top = Range("C" & i).Top
    resim.Height = Range("C" & i).Height
    resim.Width = Range("C" & i).Width
Next i
End Sub

 

[ercan_bora]

Hocam teşekkür ederim fakat onayı kaldırdıktan sonra resimler geri gelmiyor...

Dosyanız ektedir.

Dosya Linki:
DOSYAYI İNDİR

Sub resimgetir59()
Dim resim, i As Long, sonsat As Long, resimad As String
ActiveSheet.Pictures.Delete
sonsat = WorksheetFunction.Count(Range("B7:B" & Rows.Count))
If sonsat < 1 Then Exit Sub
sonsat = sonsat + 6
For i = 7 To sonsat
    resimad = Cells(i, "D").Value & ".jpg"
    Set resim = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\UrunResim\" & resimad)
    resim.ShapeRange.LockAspectRatio = msoFalse
    resim.Left = Range("C" & i).Left
    resim.Top = Range("C" & i).Top
    resim.Height = Range("C" & i).Height
    resim.Width = Range("C" & i).Width
Next i
MsgBox "resimler çekildi." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[ercan_bora]

Teşekkür ederim :hey:

Merhaba;
Excel dosyası UrunResim klasörünün yanında olsun (içinde değil)
İnceleyin.
İyi çalışmalar.

Link:
http://s3.dosya.tc/server15/po0s5z/ercan_bora-Onay_Kutusu_ile_rsm_getir.zip.html

 

[Orion1]

Hocam teşekkür ederim fakat onayı kaldırdıktan sonra resimler geri gelmiyor...

Onay kaldırıldıktan sonra resimler elbette gelmeyecek.Onay işaretli ise gelecek.

 

[Orion1]

Hocam teşekkür ederim fakat onayı kaldırdıktan sonra resimler geri gelmiyor...

3 nolu mesajdan dosyayı indirip tekrar deneyiniz.
Bir yerinde değişiklik yaptım.