Otomatik Resim Ekleme

[starmuco]

Selam Arkadaşlar,

Bu konu hakkında bi kaç yazı yazılmış ama hepsi karmakarışık ve hiçbirşey anlamadım. Excel eğitimine yeni başladım ve bana çok lazım olan birşey var. Yardımcı olursanız çok çok sevinirim. Konu şundan ibaret.

Benim elimde 400'den fazla ürün var ve bunları liste yapmam lazım. Excel'de listeyi yaptığım zaman her bir ürünün karşısına resmini gömmem lazım. tek tek gömmeye kalkarsam bu günlerimi alacak. Bunu herkes otomatik yapıyor ama ben beceremedim. Ekte hem excel dosyasını paylaştım hemde resimleri koydum. Excel'de öyle bi formül kurayım ki, bilgisayardaki klasörden resim kodlarıyla onları alsın excel'e gömsün küçük haliyle. (Resim boyutunu küçültmezse excel dosyası 400 mb olur çünkü resimler büyük boyutta.)

Not: Resimler en son satıra gelecek, resim kodları mavi bölümde barkod diye yazıyor.

 

[asi_kral]

Merhaba
Kitabınızda boş bir module bu kodu kopyalayın ve deneyin.

Option Explicit
Sub resim_getir()
Dim STR As Long, RSM As Variant, BŞL As Variant
Dim YL As String
Application.ScreenUpdating = False
YL = ThisWorkbook.Path & "\Ürün Resimleri\"
For Each RSM In ActiveSheet.Shapes
If RSM.Type = 13 Then RSM.Delete
Next
BŞL = ActiveCell.Address
For STR = 2 To Cells(Rows.Count, "B").End(xlUp).Row
Cells(STR, "M").Select
ActiveSheet.Pictures.Insert(YL & Cells(STR, "B").Text & ".jpg").Select
Selection.Top = ActiveCell.Top
Selection.Left = ActiveCell.Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = ActiveCell.Height
Selection.ShapeRange.Width = ActiveCell.Width
Next
Range(BŞL).Select
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation
End Sub

Dosyanız Ekte.

 

[starmuco]

Hocam tek kelimeyle müthişsin, o mübarek ellerinden öpmek lazım senin. yolladığın dosyaya bi ürün kodu yazdım ve o resmi o kodla adlandırdım, sonra resim butonuna bastım ve resim otomatik geldi.. bu süper.. ama ben bunu başka bi excel listeme nasıl yapacam, modüle yaz felan demişsin ama pek anlamıyorum excel'den kısaca açıklarsan çok makbul geçer.

 

[biggboss]

arkadaşlar böyle cevapları yazıyorsunuz yeni başlayanlar için kısa açıklamalar da yapsanız iyi olmaz mı ?

 

[asi_kral]

Hocam tek kelimeyle müthişsin, o mübarek ellerinden öpmek lazım senin. yolladığın dosyaya bi ürün kodu yazdım ve o resmi o kodla adlandırdım, sonra resim butonuna bastım ve resim otomatik geldi.. bu süper.. ama ben bunu başka bi excel listeme nasıl yapacam, modüle yaz felan demişsin ama pek anlamıyorum excel'den kısaca açıklarsan çok makbul geçer.

Asil marifet bildiklerini öğretmek.
Gönderdiğim dosyayı açın Alt+F11 yapın yeni bir sayfa açılacak sol köşe de module var. Ondan bahsetmiştim. Nasıl onu açacağına gelince Sol bölümde sağ tuş tıklayın Insert - Module yapın. Yada üst menülerden Insert - Module yapın.
Kolay Gelsin.
Not : Dosya makrolu dosyadır. Makro Güvenlik ayarlarını düşürmelisiniz_? Uygulamalı Excel bölümünde açıklamalı şekilde mevcuttur bu bilgiler.

 

[banjir]

çok yararlı oldu .pek bir şey anlamadım

 

[Seyyid]

Merhaba, Kodu çalıştırdığım zaman 750 adet resim yüklüyor ama sonra ekte bulunan hatayı veriyor. Nasıl çözebilirim.

 

[missdizayn]

Resim ekleme

merhaba
kitabınızda boş bir module bu kodu kopyalayın ve deneyin.

option explicit
sub resim_getir()
dim str as long, rsm as variant, bşl as variant
dim yl as string
application.screenupdating = false
yl = thisworkbook.path & "\ürün resimleri\"
for each rsm ın activesheet.shapes
ıf rsm.type = 13 then rsm.delete
next
bşl = activecell.address
for str = 2 to cells(rows.count, "b").end(xlup).row
cells(str, "m").select
activesheet.pictures.ınsert(yl & cells(str, "b").text & ".jpg").select
selection.top = activecell.top
selection.left = activecell.left
selection.shaperange.lockaspectratio = msofalse
selection.shaperange.height = activecell.height
selection.shaperange.width = activecell.width
next
range(bşl).select
application.screenupdating = true
msgbox "işlem tamamlandı", vbınformation
end sub

dosyanız ekte.

bende 3000 adet resim var, ama bu dosya tümünü getirmiyor, bana da çok lazım, yardımınızı rica ederim

 

[missdizayn]

merhaba
kitabınızda boş bir module bu kodu kopyalayın ve deneyin.

option explicit
sub resim_getir()
dim str as long, rsm as variant, bşl as variant
dim yl as string
application.screenupdating = false
yl = thisworkbook.path & "\ürün resimleri\"
for each rsm ın activesheet.shapes
ıf rsm.type = 13 then rsm.delete
next
bşl = activecell.address
for str = 2 to cells(rows.count, "b").end(xlup).row
cells(str, "m").select
activesheet.pictures.ınsert(yl & cells(str, "b").text & ".jpg").select
selection.top = activecell.top
selection.left = activecell.left
selection.shaperange.lockaspectratio = msofalse
selection.shaperange.height = activecell.height
selection.shaperange.width = activecell.width
next
range(bşl).select
application.screenupdating = true
msgbox "işlem tamamlandı", vbınformation
end sub

dosyanız ekte.

hmerhaba; ekteki dosya sınırlı satırmı var? Bende 3000 adet resim var, 65. Satırdan sonra resimler gelmiyor, hata veriyor. Yardımcı olursanız sevinirim