Çalışma sayfasında resim gösterme...

[ozgretmen]

Merhaba Arkadaşlar ;

Ekte göndermiş olduğum çalışma sayfamda yer alan açılır kutu aracılığı ile , kitabın bulunduğu dizindeki *.jpg uzantılı dosyaları image nesnesinde göstermek istiyorum.Yardımcı olursanız sevinirim.İyi çalışmalar.

 

[Levent Menteşoğlu]

Dosyanızdaki gibi bir image nesnesi kullanacak olursanız aşağıdaki kodu kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & [c10] & ".jpg")
End Sub

Resmi direk sayfa üzerine eklemek istersenizde aşağıdaki kodu kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [c10]) Is Nothing Then Exit Sub
ActiveSheet.Shapes("resim").Delete
[d10].Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & [c10] & ".jpg").Select
Selection.Name = "resim"
Selection.ShapeRange.Height = 118
Selection.ShapeRange.Width = 109.75
[c10].Select
End Sub

 

[ozgretmen]

Teşekkürler...Çok makbule geçti.İyi çalışmalar.Saygılar...

 

[alaybeyli]

Teşekkürler...Çok makbule geçti.İyi çalışmalar.Saygılar...

Öğretmen arkadaşım problemi nasıl hallettin, bir kaç resimlik örnek verebilirmisin. yardımcı olursan memnun olurum.

 

[alaybeyli]

Resmi direk sayfa üzerine eklemek istersenizde aşağıdaki kodu kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [c10]) Is Nothing Then Exit Sub
ActiveSheet.Shapes("resim").Delete
[d10].Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & [c10] & ".jpg").Select
Selection.Name = "resim"
Selection.ShapeRange.Height = 118
Selection.ShapeRange.Width = 109.75
[c10].Select
End Sub

[/QUOTE]

Dosya güzel, işime yarayacak ama, isimler ile fotoğraf arasına bir sütün ilave edemiyorum. eklenen resimler isimlerin üzerini kısmen kapatıyor. lütfen yardım

 

[aliakgul]

Dosyanızdaki gibi bir image nesnesi kullanacak olursanız aşağıdaki kodu kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & [c10] & ".jpg")
End Sub

Merhaba,
Bu kodlar üzerinde küçük bir değişikliğe ihtiyacım olacak.
a.) Resimleri, çalışma kitabının yanında yer alan (çalışma kitabıyla aynı dizindeki) "resimler" adlı bir klasörden çağırmak istiyorum.
b.) Ben C10 hücresine tıklamadan, formlar araç çubuğundan oluşturduğum bir açılır pencereden isim seçiyorum. C10 hücresinde ise DÜŞEYARA fonksiyonu var ve gerekli isim tanımlaması bu şekilde yapılıyor. Buraya kadar herşey normal ama mevcut kodlarla resmin değişmesi için c10 hücresine illaki tıklanması gerekiyor.Oysa ben istiyorum ki, açılır pencereden ismi seçince c10'daki ismin foroğrafı image penceresinde görüntülensin.
Sanırım sorunu anlatabildim..Şimdiden teşekkür ediyorum.

 

[aliakgul]

Sayın leventm,
yukarıdaki sorumla ilgilenebilirseniz sevinirim... teşekkürler...

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin. Kod zaten C10 hücresinde veri değiştiğinde çalışacaktır.

[LEFT]Private Sub Worksheet_Change(ByVal Target As Range)
if intersect(target,[c10]) is nothing then exit sub
Image1.Picture = LoadPicture("c:\resimler\" & [c10] & ".jpg")
End Sub[/LEFT]

 

[aliakgul]

Sayın Leventm,teşekkür ederim, tam istediğim gibi oldu.
Ancak ben-hoşgörünüze sığınarak- aşağıdaki biçimde bir düzenleme yaptım ki; böylece ilgili dosya ve klasör başka bir sürücüye taşınırsa hata vermeyecektir...
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\resimler\" & [c10] & ".jpg")

-------------------------
Bu kodları geliştirme açısından bir soru eklemek istiyorum:
Yukarıdaki kodlara göre, [C10] hücresindeki değeri isim olarak taşıyan jpeg resmi resim kutusunda görüntülenecek.
Eğer [C10] hücre değerini isim olarak taşıyan bir resim yoksa excel macro hatası vermektedir.Şöyle yapabilirmiyiz?
......................
Resimler klasörüne "manzara" isimli bir jpeg resmi koyalım.
Resimler klasöründe [C10] hücre değerini isim olarak taşıyan bir resim yoksa "manzara" adındaki resim görüntülensin...

 

[Levent Menteşoğlu]

Kodu aşağıdaki gibi düzenleyin.

[LEFT]Private Sub Worksheet_Change(ByVal Target As Range)
on error goto 10
if intersect(target,[c10]) is nothing then exit sub
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\resimler\" & [c10] & ".jpg")
exit sub
10 Image1.Picture = LoadPicture(ThisWorkbook.Path & "\resimler\manzara.jpg")
End Sub[/LEFT]

 

[aliakgul]

On Error GoTo 10

Yukarıda verdiğim satırda hata oluşuyor. Buradaki 10 neyi ifade ediyor?

 

[Levent Menteşoğlu]

Kodda hata yapmışım yukarıda düzelttim tekrar deneyin. 10 kod içinde hata durumunda gidilecek satırın numarasıdır.

 

[aliakgul]

Bahsettiğim satırı silerek de halletmiştim, düzelttim.
Emekleriniz için çok teşekkür ederim.Elinize, yüreğinize sağlık...