Dosyadan resim alma....

[a.cogurcu]

Merhaba arkadaşlar,
Ben ayrı bir dosyada bulunan resimleri bir hücredeki isme göre sayfaya getirtip hücreye göre boyutlandırmak istiyorum. Yardımcı olabilir misiniz?

Formdaki örnekleri biraz inceledim ama uyarlarken hata verdim...

Yardımlarınız için şimdiden çok teşekkür ederim...

 

[a.cogurcu]

yardımcı olabilecek kimse yok mu acaba?

 

[Necdet]

7 dakikada çözüm bekliyorsunuz.

Aşağıdaki kodlar ilgili sayfanın kod bölümünde olmalı, F6 hücresi değiştiğinde f6 daki isimle ilgili resim gelir.

Resimlerin yolu aşağıdaki kırmızı olarak belirtilen yeri kendinize göre ayarlayınız.

Yine aşağıdaki kodlara göre uzantısı jpg olan dosyaları listeler.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [F6]) Is Nothing Then Exit Sub
Image1.Picture = LoadPicture("[COLOR=red][B]C:\Resimler\[/B][/COLOR]" & [F6] & ".jpg")
Image1.PictureAlignment = fmPictureAlignmentCenter
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.PictureTiling = False
End Sub

 

[tahsinanarat]

Resimden isme gitme

Resimlerinizin d sürücüsünde foto isimli klasörde olduğu varsayılmıştır, siz klasör yolunu kendinize göre değiştiriniz, Necdet hocam çok güzel bir çözüm sunmuş, benim ki de başka bir altarnatif olsun, resimlerinizi güncelledikten sonra seçeceğiniz resim ismine göre bilgilerinizi getirebilirsiniz. (yarım saattir bununla uğraşıyordum, boşa gitmesin diye ekliyorum.) Kolay gelsin.

 

[a.cogurcu]

Hocam çok teşekkür ederim emeğine sağlık... evet biraz acele ettim galiba.... son birkaç saattir bunu deniyorum olmadı bir türlü... ondan acelemiz!!!

Sağol

 

[a.cogurcu]

tahsinanarat sana da teşekkür ediyorum emeğine sağlık....

Bu site gerçekten çok faydalı bütün arkadaşlar çok yardımsever... başka bir yerde olsa hiç cevap alamazdınız herhalde....

 

[leumruk]

Selamlar,
Syn. Necdet Bey, alınan resmi hücreye göre otomatik boyutlandırabiliyor muyuz?

 

[a.cogurcu]

doğrusu bu benim de işime yarar!!! ilgilenirseniz sevinirim!!!!

 

[a.cogurcu]

arkadaşlar yardımcı olabilecek kimse yok mu?

 

[Necdet]

Selamlar,
Syn. Necdet Bey, alınan resmi hücreye göre otomatik boyutlandırabiliyor muyuz?

Aşağıdaki linki inceleyiniz.

http://www.excel.web.tr/f136/personel-bilgileri-resimli-3-ornek-dosya-t22790.html

 

[Necdet]

Tekrar Merhaba,

Arşivimde olan kodları buraya eklemek istiyorum. Hücre boyutuna göre resim boyutunu ayarlar.

İnternetten bulmuştum sanırım bu kodları, adresi unuttuğum için burada yayınlayamıyorum. Aşağıdaki kodların ilgili sayfanın kod bölümünde olması yeterli.

A1 deki değere sahip jpg uzantılı dosyayı D2 hücresinin boyutuna göre getirir ve ayarlar. Resim dosyalarının bulunduğu yolu da siz kendinize göre ayarlayınız.

'With the macro below you can insert pictures and fit them to any range in a worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "[COLOR=red][B]$A$1"[/B][/COLOR] Then Exit Sub
 TestInsertPictureInRange
End Sub

Sub TestInsertPictureInRange()
ActiveSheet.Pictures.Delete
Dim ResimDosya As String
ResimDosya = "[B][COLOR=red]C:\Foto\[/COLOR][/B]" & [A1] & ".jpg"
InsertPictureInRange ResimDosya         '-----, Sheets("Sayfa1").Range("D2")
End Sub

Sub InsertPictureInRange(PictureFileName As String) '---- , TargetCells As Range
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
'    With TargetCells
    With [COLOR=red][B][D2]
[/B][/COLOR]        t = .Top
        l = .Left
        w = .Offset(0, .Columns.Count).Left - .Left
        h = .Offset(.Rows.Count, 0).Top - .Top
    End With
    ' position picture
    With p
        .Top = t
        .Left = l
        .Width = w
        .Height = h
    End With
    Set p = Nothing
End Sub

 

[a.cogurcu]

Hocam dosyaya uygulayabilir misiniz? ben uyguladım ama hata veriyor... exceli daha yeni yeni öğreniyorum...

birde F6 hücresine düşeyara ile veri aldığım için resim istediğim B37 hücresine gelmiyor!!! Dosyanın ismini yazınca geliyor. acaba bunu düzeltebilir miyiz?

 

[a.cogurcu]

dosya ekte....:yardim:

 

[a.cogurcu]

hocam otomatik boyutlandırmayı hallettim teşekkür ederim...

fakat; düşeyara problemi devam ediyor....

yardımlarınızı bekliyorum!!!!!!!!

 

[tahsinanarat]

Güncelleştirme yaptığın dosyadan da bir örnek dosya gönderebilirsen, bir fikir verilebilir.

 

[Necdet]

hocam otomatik boyutlandırmayı hallettim teşekkür ederim...

fakat; düşeyara problemi devam ediyor....

yardımlarınızı bekliyorum!!!!!!!!

Formülle değişen hücre kodların çalışması için yetmiyor. Formülünüzde aramayı A1 hücresine göre yapıyorsunuz. O halde kodları A1 e göre ayarlamak gerek.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Image1.Picture = LoadPicture("C:\Resimler\" & [F6] & ".jpg")
End Sub

 

[a.cogurcu]

hocam enedim ama bir türlü çözemedim... yardımcı olabilir misiniz?

 

[Necdet]

Merhaba,

Olmayan nedir? Siz DÜŞEYARA fonksiyonunu sanırım başka dosyadan kullanıyorsunuz, dolayısıyla o formülü bozmamak için (çünkü dosyayı açtığımızda tam olarak anlaşılmıyor) kurcalamadım.

 

[a.cogurcu]

Dosyayı gönderiyorum bi baka bilir misiniz?

:yardim:

 

[a.cogurcu]

Düşey ara A1 hücresine bağlı....