Listbox ve İmage nesnesi

[mixser]

Merhaba arkadaşlar

Yaptığım bir çalışmada excel sayfası üzerine yerleştirilmiş Listbox ve İmage nesnesi var.
Bu Listbox ta görmek istediğim liste "C:\Resimlerim " klasöründeki resimlerin adı olsun. Bu resimlerin isimlerini seçtikçe Image nesnesinde resimleri de görmek istiyorum. Bu işlemi User form üzerinde yapıyorum.
Ama excel sayfası üzerinde yapmak istiyorum. Yardımcı olabilirmisiniz
Teşekkür ederim.

 

[Orion1]

C:\Resimlerim diye bir klasörünüzün olması ve içind jpg formatlı resim dosyalarınızın olması gerekiyor.
Ekli dosyayı inceleyiniz.

Sub Auto_Open()
Set s1 = Sheets("Sayfa1")
yol = "C:\Resimlerim"
dosya = Dir(yol & "\*.jpg")
Do While dosya <> ""
    s1.ListBox1.AddItem dosya
    dosya = Dir
Loop
End Sub

Private Sub ListBox1_Click()
Image1.Picture = LoadPicture("C:\Resimlerim\" & ListBox1.Value)
End Sub

 

[mixser]

Verdiğiniz cevap için teşekkür ederim sn. Orion

Bi yandan cevap beklerken biyandan da araştırma forumda yaptığım bir araştırmadan yrarlanarak olayı açıklığa kavuşturdum. Ellerinize sağlık verdiğiniz kod epey işime yarayacak.
bağlı olarak başka bir sorum olacak. bu yaptığım resim getirme olayını veri doğrulama yöntemi ile yapıyorum hücreye klasör içinde olmayan bir resmin adını girdiğimde hata kodu alıyorum bu hatayı nasıl önlerim yani hücreye daha klasöre konmamış bir resmin adını girdiğimde hata mesajı gelmesin yada klasörün içine koyacağım bir ünlem resmi gelsin.
ifadem karışık oldu ise özür dilerim. Yardımını bekliyorum.
saygılarımla

 

[Orion1]

Aşağıdaki kodlar çalışma sayfasının kod bölümüne yazılmıştır.
C:\Resimlerim klasöründe yok.jpg isminde bir resim dosyasının olması lazım.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo yok
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Image1.Picture = LoadPicture("C:\Resimlerim\" & Range("B2").Value)
Exit Sub
yok:
Image1.Picture = LoadPicture("C:\Resimlerim\yok.jpg")

End Sub

 

[mixser]

merhabalar
öncelikle verdiğiniz cevaplar için teşekkür ediyorum
projem ilerledikçe sorunlar değişiyor.

Sub Autpen()
Set s1 = Sheets("Giriş")

yol = "C:\Resimlerim"
dosya = Dir(yol & "\*.jpg")
Do While dosya <> ""
s1.ComboBox1.AddItem dosya
dosya = Dir
Loop
End Sub
bu kodla c deki resimlerim klas&#246;r&#252;nden resim gitrmeyi ba&#351;ard&#305;m sayenizde

resim isimlerini combobox1 de listeliyorum ve buradan se&#231;ti&#287;im resim image nesnesinin &#252;zerine geliyor buraya kadar s&#252;per.

ikinci ad&#305;m
combobox1 in alt&#305;na command buton ekleyerek buna "Getir" ismini verdim.
Daha &#246;nceden "Giri&#351;" sayfas&#305;ndan girip "Data" sayfas&#305;na kaydetti&#287;im bilgiler var.
combobox1 de g&#246;r&#252;len resim isimleri ile "Data" sayfas&#305;ndaki "E" st&#252;nunda yer alan kodlar ayn&#305;d&#305;r. combodan listeleyip resmini g&#246;rd&#252;g&#252;m &#252;r&#252;n&#252; getir butonuna basarak data sayfas&#305;nda Kod st&#252;nunda arat&#305;p bulduktan sonra bu kodun bulundu&#287;u sat&#305;rdaki bilgileri giri&#351; sayfas&#305;nda yer alan yerlerine getirmesi gerekiyor.

Birde comboda g&#246;r&#252;len resim isimlerinin &#246;rne&#287;in:"140.jpg" de&#287;ilde "140" &#351;eklinde g&#246;stermek m&#252;mk&#252;nm&#252;d&#252;r.

sorular&#305;mla &#231;ok oluyorsam kusura bakmay&#305;n
Sayg&#305;lar&#305;mla

 

[Orion1]

butona aşağıdaki kodu yazınız.
Image1.Picture = LoadPicture("C:\Resimlerim\" & combobox1.value)

 

[mixser]

Sn orion
butona kodu yaz&#305;n demi&#351;siniz ama pek anlayamad&#305;m.
de&#287;i&#351;en bir &#351;ey olmad&#305; bu koddan ama&#231; nedir. ?

 

[Orion1]

küçük bir örnek dosya ekleyiniz ve üzerine açıklamasını yazınız.

 

[mixser]

Çalıştığım dosyamı ekliyorum ve yardımlarınızı bekliyorum.

 

[Orion1]

Dosya uzantılarının gösterilmemesi benden .
Ekli dosyayı inceleyiniz.

 

[mixser]

Te&#351;ekk&#252;rler sn. Orion
devam&#305; i&#231;in en ne yap&#305;labilir. en az&#305;ndan combodaki de&#287;eri data sayfas&#305;nda nas&#305;l arataca&#287;&#305;m hakk&#305;nda bi ip ucu verseydiniz

 

[Orion1]

Dosyanız hazır.
Ekli dosyayı inceleyiniz.

Private Sub cmdgetir_Click()
Sheets("Giriş").Select
Set s2 = Sheets("Data")
Range("C4:J6").ClearContents
Range("M5:N5").ClearContents
Range("B9:M23").ClearContents
sat = 9
Set k = s2.Range("E2:E65536").Find(Range("L5").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    Range("C4").Value = s2.Cells(k.Row, "G").Value
    Range("C5").Value = s2.Cells(k.Row, "H").Value
    Range("M5").Value = s2.Cells(k.Row, "F").Value
    Range("N5").Value = s2.Cells(k.Row, "B").Value
    For i = 12 To 110 Step 7
        If s2.Cells(k.Row, i).Value <> 0 Then
            Cells(sat, "B").Value = s2.Cells(k.Row, i).Value
            Cells(sat, "F").Value = s2.Cells(k.Row, i + 1).Value
            Cells(sat, "G").Value = s2.Cells(k.Row, i + 2).Value
            Cells(sat, "I").Value = s2.Cells(k.Row, i + 3).Value
            Cells(sat, "J").Value = s2.Cells(k.Row, i + 4).Value
            Cells(sat, "L").Value = s2.Cells(k.Row, i + 5).Value
            sat = sat + 1
        End If
    Next
End If
End Sub

 

[mixser]

sn. orion2
verdi&#287;iniz cevap ve &#231;&#246;z&#252;mler i&#231;in te&#351;ekk&#252;r ediyorum.
i&#351;im b&#252;y&#252;k &#246;l&#231;&#252;de tamamlanmak &#252;zere sa&#287;olun var olun.
sayg&#305;lar&#305;mla

 

[Orion1]

sn. orion2
verdiğiniz cevap ve çözümler için teşekkür ediyorum.
işim büyük ölçüde tamamlanmak üzere sağolun var olun.
saygılarımla

Rica ederim.
İyi çalışmalar.