Soru RESİM EKLEME

[engin52]

Merhaba arkadaşlar.
Bir sayfada herhangi bir hücreye formül yazarak yada kodla resim ekletebilir miyiz. Resim adına göre sayfadaki tablonun herhangi bir yerine ekleyebilir miyiz?
iyi çalışmalar

 

[bycakir]

aşağıdaki kodu modül olarak excele ekleyin

excelde resim görmek istediğiniz hücreye "=Resim($P$1&"\"&X8&".jpg";50;59)" yapıştırın P1 temsilidir. P1 hücresinede resim klasörünün yolunu yazın örn"D\Resimler" gibi bu arada resim ismi ile yukarıda yazdığım x8 hücresindeki isim veya numara aynı olmalıdır ve resmin uzantısı jpg olmalıdır. x8 de temsilidir.

yapamaz iseniz örnek bir excel ve resim yükleyin. örnek yapalım.

Function Resim(ByVal resad As String, Optional ByVal gen As Single = 200, _
                                                        Optional ByVal yuk As Single = 150)
        
    Dim hcr      As Range
    Dim res      As Object
    
    Set hcr = Application.Caller
    
    For Each res In hcr.Parent.Pictures
        If res.TopLeftCell.Address = hcr.Address Then
            res.Delete
            Exit For
        End If
    Next
    
    Set res = hcr.Parent.Pictures.Insert(resad)
    With res
        .Left = hcr.Left + 1
        .Top = hcr.Top + 1
        .Width = gen
        .Height = yuk
    End With
    
End Function

 

[engin52]

teşekkürler örnek hazırlıyorum

 

[engin52]

Örnek ektedir. Dediğiniz gibi kodu kod sayfasına yapıştırdım.

 

[engin52]

Örnek 3 adet de resim gönderdim.

 

[halit3]

Benzer bir kaç sorunuz var esas dosyanızı şimdi eklediniz herhalde
Dosyanızın yanında Resimler adı altında klasör olmalı ve resimler burada tc kimlik numarası ile adlandırılmalı
Al hücresindeki sırayı değiştirip kodu çalıştırın.

Sub deneme1()

sat1 = 3 'İlk satır
sat2 = 9 'Son satır
sut1 = "I" 'İlk sütun
sut2 = "J" 'Son sütun

Set Adres = Range(Cells(sat1, sut1), Cells(sat2, sut2))

Dim Picture As Object
For Each Picture In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
If Not Intersect(Range(Picture.TopLeftCell.Address & ":" & Picture.BottomRightCell.Address), Adres) Is Nothing Then

Picture.Delete
Exit For
End If
End If
Next Picture

klasor = ThisWorkbook.Path & "\Resimler\"
isim = Cells(12, "C").Value

ReDim uzanti(12)
uzanti(1) = ".bmp":        uzanti(2) = ".jpg"
uzanti(3) = ".gif":        uzanti(4) = ".pcx"
uzanti(5) = ".tga":        uzanti(6) = ".emf"
uzanti(7) = ".abm":        uzanti(8) = ".avi"
uzanti(9) = ".png":        uzanti(10) = ".jpeg"
uzanti(11) = ".wmf":       uzanti(12) = ".TIFF"

For i = 1 To 12

If CreateObject("Scripting.FileSystemObject").FileExists(klasor & isim & uzanti(i)) = True Then
ActiveSheet.Pictures.Insert(klasor & isim & uzanti(i)).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.Top = Adres.Top + 2
Selection.Left = Adres.Left + 2
Selection.ShapeRange.Height = Adres.Height - 3
Selection.ShapeRange.Width = Adres.Width - 3

Exit For
Cells(1, 1).Select
End If

Next


End Sub

 

[engin52]

Halit Bey yardımınız için teşekkürler.
Ayrıca Basic bilmediğimden makronun çalıştır butonunu sayfa üzerine nasıl eklerim.

 

[bycakir]

alternatif olarak ekteki dosyayıda kullanabilirsiniz klasörün içindeki Resimler klasörüne resimlerinizi atınız.

 

[engin52]

Teşekkürler bycakir

 

[halit3]

Dosyanız ekte

 

[engin52]

Teşekkürler Halit Bey,
Dosyada 2. kişinin bilgilerinde 1. kişinin fotoğrafı geliyor.

 

[halit3]

Kod C12 hücresindeki veriye göre resim getiriyor.
Kodun içindeki aşağıdaki bölüm varsa silin

Cells(1, 1).Value = Cells(1, 1).Value + 1

 

[halit3]

Dosyalar

 

[engin52]

Teşekkürler