Resim ekleme

[maestrocan]

Benim elimde resimlerin olduğu masaüstünde bir klasörüm var. Resim isimleride göndermiş olduğum örnek excellerinde Artikel No diye geçiyor. Macroyu çalıştırdığım zaman Artikel No'ya göre resim klasöründen resmi bulup eklemesi. Eğer ürünün resmi yok ise resim klasöründe ismi Noimage getirmesini istiyorum veya boş bırakmasını istiyorum.
Resimleri eklerken boyutlandırma oranı verebiliyorsak Yükseklik:6,11cm Genişlik:4,58cm verebilirmiyiz.

http://dosya.co/fzwrqeszq19m/ornek.xls.html

http://dosya.co/u5pnqeb4p5hn/ornek_bitmis_hali.xls.html



Şimdiden Teşekkür Ederim.

 

[Necdet]

Merhaba,

dosya.tc varken diğer siteleri neden tercih ediyorsunuz? bir sürü şey yüklüyor.

 

[maestrocan]

Merhaba,

dosya.tc varken diğer siteleri neden tercih ediyorsunuz? bir sürü şey yüklüyor.

Afedersiniz bilmiyordum belirtmiş olduğunuz yerden dosyayı tekrar yolluyorum.

Kusura bakmayınız.


http://www.dosya.tc/server12/posjy7/ornek_bitmis_hali.xls.html
http://www.dosya.tc/server12/u0f4xd/ornek.xls.html

 

[alicimri]

Resim klasör ve yolunu kendinize göre değiştirin.

Sub A()
For i = 1 To Range("B65536").End(3).Row
If Range("B" & i) = "Artikel" Then
If Dir("D:\resim\" & Range("B" & i + 1) & ".jpg") <> "" Then
ad = "D:\resim\" & Range("B" & i + 1) & ".jpg"
Else
ad = "D:\resim\Noimage.jpg"
End If
Worksheets(1).Shapes.AddPicture ad, True, True, 15, Range("A" & i + 2)..Top, 120, 180
End If
 Next
End Sub

 

[maestrocan]

Resim klasör ve yolunu kendinize göre değiştirin.

Sub A()
For i = 1 To Range("B65536").End(3).Row
If Range("B" & i) = "Artikel" Then
If Dir("D:\resim\" & Range("B" & i + 1) & ".jpg") = "" Then
ad = "D:\resim\" & Range("B" & i + 1) & ".jpg"
Else
ad = "D:\resim\Noimage.jpg"
End If
Worksheets(1).Shapes.AddPicture ad, True, True, 15, Range("A" & i + 2)..Top, 120, 180
End If
 Next
End Sub

Güneyadın Ali bey,

Göndermiş olduğunuz macroyu bir hata olmasın diye sizin belirlemiş olduğunuz dosya yolu klasör şeklinde uyarladım. Fakat klasörün içinde 10001 ve 10005 resimleri olmasına rağmen onlara Noimage resmi geldi diğerlerine hiç bir şey gelmedi. Bir yerde hata yapıyor olabilirmiyim?

 

[alicimri]

Kusura bakmayın.
"<>" yerine "="yazmışım yukarda kodu değiştirdim.

 

[askm]

Sub A()
yol = "D:\resim\"
For i = 1 To Range("B65536").End(3).Row
If Range("B" & i) = "Artikel" Then
resim = yol & Range("B" & i + 1).Text & ".jpg"
If Len(Dir(resim)) > 0 Then
    ad = resim
Else
    ad = yol & "Noimage.jpg"
End If
Worksheets(1).Shapes.AddPicture ad, True, True, 15, Range("A" & i + 2).Top, 120, 180
End If
Next
End Sub

 

[maestrocan]

Çok teşekkür ederim ellerinize sağlık

 

[askm]

Rica ederim. Kolay gelsin.