excel macroda resim

[kuşak]

Ben bir resimlerle ilgili macro hazırlamak istiyorum fakat bir türlü istediğim gibi olmuyor. İsteğim sayfa 1 deki "A" sütununda bulunan tüm bilgileri hücrelerde yazan dosyanın adı c:\resimler\ klasörünün içindeki *.jpg uzantılı dosyanın adıyla aynı değerde olmak kaydıyla dosyaları arayıp sayfa 2 ye aktarıp göstermek

örnek sayfa 1
A B C D
1 Dosya Adı stok adı stok miktarı aranacak klasör
2 resim1 N/A N/A C:\Resimler
3 resim2 N/A N/A
4 resim3 N/A N/A command_button1
5 resim4 N/A N/A


örnekte yazıldığı gibi "A" sütunundaki yazılı olan dosya adlarını "D2" deki hedef klasörden search edip sayfa 2 ye B ve C sütunlarında yazan bilgilerle birlikte hedef klasördeki resimleriyle birlikte sergilemek. Çok uzun bi istek oldu ama inşallah anlıyan vardır )))))))

 

[Levent Menteşoğlu]

örnekte yazıldığı gibi "A" sütunundaki yazılı olan dosya adlarını "D2" deki hedef klasörden search edip sayfa 2 ye B ve C sütunlarında yazan bilgilerle birlikte hedef klasördeki resimleriyle birlikte sergilemek.

Aşağıdaki gibi bir kodla D2 hücresine yazacağınız isme ait resmi çağırabilirsiniz. Kesin çözüm için dosyanızı eklemenizi öneririm.

ActiveSheet.Pictures.Insert ("C:\resimler\" & [d2] & ".JPG")

 

[kuşak]

istediğiniz yaptım. Tam aradığım gibi fakat birden çok hücre seçip resimleri belirli aralıklarla listelemek daha çok işime yarardı örnek tablomu incelerseniz daha iyi anlarsınız çok teşekkürler

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Private Sub CommandButton1_Click()
On Error Resume Next
Application.ScreenUpdating = False
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
s2.Select
For a = 2 To s1.[a65536].End(3).Row
s2.Cells(c + 1, "d").Select
ActiveSheet.Pictures.Insert ("C:\resimler\" & s1.Cells(a, "a") & ".JPG")
c = c + 4
Next
End Sub

 

[kuşak]

sayın levenm verdiğiniz kodlama tam istediğim gibi. Fakat resimler 1024*768 - 800*600 vs pixel formatında. ve resimlerin boyutları yazıcıdan çıktı alabilmek için çok büyük. Bu resimlerin hepsini ortalama bir boyuta getirmek için manuel işlem yapıyorum . Bunun için sayfa1 de bir scroll bar oluşturup listelenecek bütün resimlerin boyutunu ayarlayacak bir makro oluştura bilirmiyiz? Bir de ikinci defa command button tuşunu tıkladğımda listelenen resimler otomatik olarak silinebilir mi? Çok şey istiyormuşum gibi geldi bana:roll:

 

[kuşak]

ekli dosyamı eklemeyi unutmuşum:???: sayın leventm verdiğiniz kodlama tam istediğim gibi. Fakat resimler 1024*768 - 800*600 vs pixel formatında. ve resimlerin boyutları yazıcıdan çıktı alabilmek için çok büyük. Bu resimlerin hepsini ortalama bir boyuta getirmek için manuel işlem yapıyorum . Bunun için sayfa1 de bir scroll bar oluşturup listelenecek bütün resimlerin boyutunu ayarlayacak bir makro oluştura bilirmiyiz? Bir de ikinci defa command button tuşunu tıkladğımda listelenen resimler otomatik olarak silinebilir mi? Çok şey istiyormuşum gibi geldi bana
ilginiz için teşekkür ederim

 

[Haluk]

Dostum Levent bey'in kodunu aşağıdaki gibi değiştirip, deneyin ...

Private Sub CommandButton1_Click()
    On Error Resume Next
    Application.ScreenUpdating = False
    Set s1 = Sheets("sayfa1")
    Set s2 = Sheets("sayfa2")
    s2.Select
    ActiveSheet.Pictures.Delete
    For a = 2 To s1.[a65536].End(3).Row
        s2.Cells(c + 1, "d").Select
        Set MyPic = ActiveSheet.Pictures.Insert("C:\resimler\" & s1.Cells(a, "a") & ".JPG")
        MyPic.Width = 50
        MyPic.Height = 50
        c = c + 8
    Next
End Sub

Gerekirse; MyPic.Width = 50 ve MyPic.Height = 50 ifadelerinde, 50 olarak belirtilen resim yükseklik ve genişlik değerlerini değiştirebilirsiniz.

 

[kuşak]

peki sayfa1 de manuel olarak yazdığım "stok kodu, stok adı, stok miktarı" yazan değerleri sayfa2 de sıralanan resmin soluna (yerlerine göre) değerlerini de sıralayabilir miyim?

 

[Haluk]

Private Sub CommandButton1_Click()
    On Error Resume Next
    Application.ScreenUpdating = False
    Set s1 = Sheets("sayfa1")
    Set s2 = Sheets("sayfa2")
    s2.Select
    ActiveSheet.Pictures.Delete
    For a = 2 To s1.[a65536].End(3).Row
        s2.Cells(c + 1, "a") = s1.Cells(a, "a")
        s2.Cells(c + 1, "b") = s1.Cells(a, "b")
        s2.Cells(c + 1, "c") = s1.Cells(a, "c")
        s2.Cells(c + 1, "d").Select
        Set MyPic = ActiveSheet.Pictures.Insert("C:\resimler\" & s1.Cells(a, "a") & ".JPG")
        MyPic.Width = 50
        MyPic.Height = 50
        c = c + 8
    Next
End Sub

 

[kuşak]

öncelikle çok zahmetleriniz için çok teşekkür ettim.

son iki isteğim daha olacak mümkünse
bu resimlerin
genişliğini "E1" hücresine
uzunluğunu "f1" hücresine
manuel olarak girerek ayarlayabilir miyiz?

bir de biz sadece uzunluk verip otomatik olarak resmin genişliğini macronun ona göre ayarladığı kod nasıl?????

(www.excel.web.tr'ye çok teşekkür ederim)

 

[kuşak]

gerçekten istediğim gibi fakat a sütununda aynı stok koduyla bir çok resim var. Ekli dosyamda tablom mevcut. Beni en iyi böyle anlarsınız diye ekledim. Yorumunuzu bekliyorum.
tekrar teşekkürler
:roll:

 

[kuşak]

düzeltme (eki koymayı unutmuşum)

tablomu göndermeyi unutmuşum

 

[kuşak]

Helppppp

TABLOMU DÜZENLEYECEK BİRİ VAR MI??????????
:???: :agla: :agla: :agla:

 

[kuşak]

yardımcı olabilecek birisi var mı???

daha önceki mesajlarımda tablom hakkında bahsetmiştim. Resimleri bir türlü tek bi kod altında toplamıyor!!!!!!!!!

tablomu göndermeyi unutmuşum