resim alma

[millerblack]

merhaba

Benim bir dosya içerisinde kod nolu resimlerim var,
örneğin A1 nolu hücreye 101 kodunu yazınca E1 hücresine dosyadaki resim gelsin

A2 nolu hücreye 102 kodunu yazınca E2 hücresine resim gelsin

mümkünmü

 

[Huseyinkis]

Ekteki konuyu incelermisiniz.

http://www.excel.web.tr/f48/klasorden-resim-aoyrma-hk-t102269.html

 

[ZorBey_]

Merhaba
İyi Çalışmalar
Arşivimde Vardı
Umarım İşinize Yarar.

 

[ZorBey_]

Rasimler E Sutununda

 

[HALILİBRAHIM]

Hocalar Merhaba;
Hocalarım bir sorum olacak ben resimlerimi belirttiğim kloserden alacak makroyu buldum çalışıyor fakat "C" sütununda hücre 1'den resim kodlarını yazmaya başlasam sıkıntı yok fakat ben "C4" hücresinden başlayarak resim kodlarını yazmam gerekiyo sebebi başlıklar felan vs..var o yüzden başladığımda "end debug" hatası alıyorum bir çaresi yokmu hocalar.. birde resim kodu yanlış oluncada "end ve debug" geliyor visual basic sayfası açılıyor bunu nasıl yok edebiliriz hocalar..

Kod Aşağıda Hocalar;

Sub Düğme3_Tıklat()
Dim a As Integer
Dim son As Integer
Dim ad As String
Dim yol As String
yol = "C:\Users\Halil\Desktop\resimler\"
son = Range("C" & Rows.Count).End(xlUp).Row ' Seçilecek sütun
For a = 1 To son
ad = yol & Cells(a, 3) & ".jpg" ' Seçilecek yol
With ActiveSheet.Pictures.Insert(ad)
.Left = Cells(a, 2).Left 'Resmin görüleceği hücre Soldan
.Top = Cells(a, 2).Top 'Resmin görüleceği hücre Üstten
.ShapeRange.LockAspectRatio = True
.ShapeRange.Height = 50
End With
Rows(a).RowHeight = 50
Next a
MsgBox "İşlem tamamlandı", vbInformation, "T A M A M"
End Sub

 

[vardar07]

Hocalar Merhaba;
Hocalarım bir sorum olacak ben resimlerimi belirttiğim kloserden alacak makroyu buldum çalışıyor fakat "C" sütununda hücre 1'den resim kodlarını yazmaya başlasam sıkıntı yok fakat ben "C4" hücresinden başlayarak resim kodlarını yazmam gerekiyo sebebi başlıklar felan vs..var o yüzden başladığımda "end debug" hatası alıyorum bir çaresi yokmu hocalar.. birde resim kodu yanlış oluncada "end ve debug" geliyor visual basic sayfası açılıyor bunu nasıl yok edebiliriz hocalar..

Kod Aşağıda Hocalar;

Sub Düğme3_Tıklat()
Dim a As Integer
Dim son As Integer
Dim ad As String
Dim yol As String
yol = "C:\Users\Halil\Desktop\resimler\"
son = Range("C" & Rows.Count).End(xlUp).Row ' Seçilecek sütun
For a = 1 To son
ad = yol & Cells(a, 3) & ".jpg" ' Seçilecek yol
With ActiveSheet.Pictures.Insert(ad)
.Left = Cells(a, 2).Left 'Resmin görüleceği hücre Soldan
.Top = Cells(a, 2).Top 'Resmin görüleceği hücre Üstten
.ShapeRange.LockAspectRatio = True
.ShapeRange.Height = 50
End With
Rows(a).RowHeight = 50
Next a
MsgBox "İşlem tamamlandı", vbInformation, "T A M A M"
End Sub

Hangi satırdan itibaren almak istiyorsan kırmızıdaki 1 değerini ona göre değiştir.
Resim isimlerindeki hatada satıra yazdığın isim veya numara resim adı ile aynı olmaz ise hata verir.

 

[HALILİBRAHIM]

Hocam çok teşekkür ederim ilginize oldu şuan fakat resim kodlarımla resim isimlerin aynı hocam izah edememişim benim sıkıntım yazılan kodda resim yoksa eğer "böyle bir resim yoktur" diye bi yazı alabilirmyim diye düşündüm bi kod buldum ama yapamadım bu sefer hep "böyle bir resim yoktur" diye komut aldım hocam mümkünmüdür acaba yapılması çünkü resim olmadığında direkt Visualın içine giriyor end , debug çıkıyor hocam..

bulduğum kod şu hocam;

sPicture = ("C:\Users\huseyin\Pictures\" & aaa & ".gif")
If Dir(sPicture) = "" Then msgbox "Böyle bir dosya yok":exit sub

 

[HALILİBRAHIM]

Vardar hocam merhaba;

hocam son kez yardımınıza ihtiyacım var;
sayenizde gelişen makroda resim yoksa eğer "resim yoktur" uyarısı alamıyormuyuz hocam yardımınız için çok teşekkür ederim.

 

[ZorBey_]

Merhaba
Sayın
HALILİBRAHIM
Umarım İstediğiniz Gibidir

 

[HALILİBRAHIM]

Sayın Asr hocam malesef açamadım ben bunu nasıl açabilirim acaba ekteki gibi bir hata verdi hocam

 

[ZorBey_]

Yalnız
Dosyayı
Göndereyim

 

[HALILİBRAHIM]

Hocam çok teşekkür ederim ilginiz için uğraşmışsınız ben bütün şirkete bu makroyu verdim resimlerde geliyor bende zaten acizane yarım yamalak anlıyorum hocam bişey bildiğimizden değil ben sizin gönderdiğiniz makroya yolu gösteremedim hocam ben serverdan çekiyorum resimleri hocam ben size benim makroyu göndersem bir baksanız ona müdehalede bulunsak hocam çok makbule geçer sayın hocam eğer resim yoksa olayını bu makronun içine MsgBox "Böyle bir resim yoktur", diye yazdırabilirsek çok güzel olur hocam veya sizin istediğiniz gibi Saygılar hocam gönderiyorum Makroyu hocam.

 

[HALILİBRAHIM]

Hocam olmuyomu acaba?

 

[vardar07]

Merhaba
Sayın
HALILİBRAHIM
Umarım İstediğiniz Gibidir

Arkadaşın göndermiş olduğu dosya tam senin istediğin gibi.Sadece aşağıda kırmızılı yerlere kendi resim klasörünü yazacaksın.Benimde makro bilgim zayıf olduğu için diğer kodlara ekleme yapamadım. Birde işin içine server girince program çalışırmı çalışmazmı bilmiyorum.Bilen arkadaşlar yardımcı olurlar. Önceki dosyada arkadaşın dosyasıda aynı dizin altında olması gerekir.
asr35 arkadaşın kodlarından

ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\[COLOR="Red"][B]Personel[/B][/COLOR]\" & Target.Value & ".jpg").Select

ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\[COLOR="red"][B]Personel[/B][/COLOR]\ResimYok.jpg").Select

 

[ZorBey_]

Merhaba
Sayın
HALILİBRAHIM
Resim Yoksa Resim yok Geliyor
Birde Bu Dosyaya Bakarmısınız.

 

[HALILİBRAHIM]

Hocalar Allah razı olsun çok teşekkür ederim ilginize vardar hocam dediniğinizi yaptım olmadı çünkü biz şirket olarak "\\srv\resimler" serverdan resimleri ortak olarak çekebilmemiz gerekiyor çünkü resimler sürekli güncelleniyor lokal olarak kullanamayız hocalar ve resimler her listede en az 200 300 adet hocalar bu 1000'e de çıkabiliyor ASR hocam sağolsun uğraştı ama hem server'dan dolayı hemde resimlerin elle teker teker yazılması gerekiyor copy pace bile kurtarmıyor hocalar ben excel formatımıda atmıştım hocalarım 300 400 adetli ürünler yazılı olarak gelir bize biz bunların yanına resimleri getiririz fakat olmayanlar olunca bari geçsin hata vermesin istedik veya bir uyarı kutusu çıksın böyle bir resim yok desin bizde "tamam'a" basalım.
işlem tamamlandı mantığı gibi çalışsın yani sonuna kadar geldik sonda tıkandık hocalar inşallah bir arkadaş bize yardımcı olur..
İlginize çok teşekkür ederim arkadaşlar zahmet verdik
Saygılar...