Otomatik resim kaydetme

[ErdemBakir24]

Merhaba,

ekteki örnek dosyada resimleri, a sütunundaki kodlar ile bir klasöre kaydedebilmek için ne yapmam gerekiyor.

http://s3.dosya.tc/server10/p5ow9n/products.xlsx.html

teşekkürler

 

[rabbace]

Hocam dosyayı farklı kaydet - Web sayfası olarak kaydet dersen bütün resimleri sırayla kaydediyor fakat dosya adını image1, image2... gibi otomatik adlandırıyor. A sütunundaki kodları dosya adı olarak veremedim.

 

[ErdemBakir24]

Tekrar teşekkür ederim rabbace

 

[tahsinanarat]

İsimleri değiştirilmiş resimleriniz

Resimleri web sayfası olarak kaydetip bir klasöre aldım, image003.png gibi isim vererek exceldeki sırasıyla aldığını görünce önce .jpg çevirdim sonra dosya ismi değiştirme kodlarıyla isimlerini a sütunundaki ürün isimleriyle değiştirdim, çözümü ulaşana kadar resimleriniz lazım olur diye ekli rar dosyasında gönderiyorum.

http://s3.dosya.tc/server10/10dg2o/abc.rar.html

 

[tahsinanarat]

Aşağıdaki kodlar c sürücüsüne belirtilen klasöre resimleri a sütunundaki isimlerle aldı, ancak resimler görünmüyor, boş gözüküyor, excel 2003 veya 2010 ve 2013 ü olan arkadaşlar deneyip sonucu bildirebilirlerse sevinirim.

Sub Resim_Kaydet()

    Dim rsm As Shape, yol As String, sat As Long, grf As Object

    yol = "C:\ProResimler\"

    Application.ScreenUpdating = False

    For Each rsm In ActiveSheet.Shapes
        sat = rsm.TopLeftCell.Row
        rsm.Copy
        Set grf = ActiveSheet.ChartObjects.Add(0, 0, rsm.Width, rsm.Height)
        grf.Chart.Paste
        grf.Chart.Export yol & Cells(sat, "A") & ".jpg"
        grf.Delete
    Next rsm

    Application.ScreenUpdating = True

End Sub

 

[tahsinanarat]

Office 2003 kurdum denedim, sonuç yine aynı, uzman arkadaşlarımız kodlara bakabilirse sonuç alabiliriz belki. Bu kodu çok zaman önce denediğimi hatırlıyorum. Olumlu sonuçlar almıştım.

 

[rabbace]

Tahsinanarat hocam, excel 2016 da denedim, bahsettiğiniz şey oldu bende de isimleri aldı fakat boş resim çıktı.

 

[Zeki Gürsoy]

Koda "grf.Select" eklerseniz resimler çıkar.

[SIZE=2]Sub Resim_Kaydet()

    Dim rsm As Shape, yol As String, sat As Long, grf As Object

    yol = "C:\ProResimler\"

    Application.ScreenUpdating = False

    For Each rsm In ActiveSheet.Shapes
        sat = rsm.TopLeftCell.Row
        rsm.Copy
        Set grf = ActiveSheet.ChartObjects.Add(0, 0, rsm.Width, rsm.Height)
        [COLOR=Blue][B]grf.Select[/B][/COLOR]
        grf.Chart.Paste
        grf.Chart.Export yol & Cells(sat, "A") & ".jpg"
        grf.Delete
    Next rsm

    Application.ScreenUpdating = True

End Sub[/SIZE]

 

[ErdemBakir24]

Zeki Gürsoy,

Çok Teşekkürler. Varolun..

 

[tahsinanarat]

Sn. Zeki hocam, çok teşekkür ederim, arşivimdeki eksik bilgiyi tamamlamış oldum sayenizde.
tabii ErdemBakir24 de teşekkür ederim, böyle bir konu açmasaydı bilmeyecektik.

 

[ErdemBakir24]

tahsinanarat merhaba,

vermiş olduğun uğraş için bende sana çok teşekkür ederim. Gözden kaçırmış olmalıyım kusura bakma

 

[asercanbasak]

iyi akşamlar vermiş olduğunuz kodlar çok işime aradı fakat şöyle bir sorunum var. 10,000 den fazla satırın içerdiği sayfada. bu satırların bazılarında resim/shape mevcut değil fakat yanındaki hücrelerde bilgisi mevcut. sorun klasöre kaydederken kodlar resmin olmadığı hücreyi atlıyor fakat yanındaki bilgileri atlamadığı için bir sonraki resimde bir önceki satırda yer alan bilgiyi klasöre kaydediyor. bunun için eğer hücrede resim/shape yoksa o satırdaki bilgileri almadan devam etmesini sağlayacak nasıl bir kod yazılabilir? yardımcı olursanız memnun olurum. kolay gelsin