kişi adına göre resimlerin aktarılması

[metot]

arkadaşlar ekteki örnek dosyada, kişi adını yazdığımızda resimler sayfasındaki ilgili resimleri nasıl aktarabiliriz, yardımcı olacak arkadaşlara şimdiden teşekkür ederim...

 

[hamitcan]

Arama yapın isteğinizle ilgili örnekler sitede mevcut.

 

[metot]

sayın hamitcan

sitede arama yaptım fakat, örneklerde seçilen isme göre tek bir resim geliyor, benim istediğim şey farklı yazılan yada seçilen isme birden fazla resimin ilgili bölüme aktarılması gerekiyor, arama yapacağım kelime hakkında veya link hakkında yardımcı olabilirmisiniz, teşekkür ederim...

 

[Orion1]

Ekli dosyayı inceleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, isim As String
On Error GoTo son1
isim = Empty
isim = Target.Value
For i = 1 To Shapes.Count
    If ActiveSheet.Shapes(i).Name = Target.Value Then
        ActiveSheet.Shapes(Target.Value).Delete
    End If
Next
son1:
On Error GoTo son
Sheets("resimler").Shapes(isim).Copy
ActiveSheet.Paste
Selection.Left = Target.Offset(-1, 0).Left
Selection.Top = Target.Offset(-1, 0).Top
son:
Application.CutCopyMode = False
Target.Select
End Sub

 

[metot]

sayın Evren Gizlen

hocam ilginize çok teşekkür ederim, istediğim şey tam olarak buydu, emeğinize sağlık kolay gelsin.

 

[Orion1]

hocam ilginize çok teşekkür ederim, istediğim şey tam olarak buydu, emeğinize sağlık kolay gelsin.

Rica ederim.
İyi çalışmalar.

 

[mbattal]

Sayın hocam,
peki bu resimler bir sayfada değilde farklı bir yerde bir klasör içinde olursa kodda nasıl bir değişiklik yapılması gerekir ?

 

[Orion1]

Sayın hocam,
peki bu resimler bir sayfada değilde farklı bir yerde bir klasör içinde olursa kodda nasıl bir değişiklik yapılması gerekir ?

Aşağıdaki kodlar C1 hücresine klasörden jpg uzantılı resim dosyasını getiriyor.
Siz aşağıdaki satırdaki Yol'u ve Dosya adını kendinize göre değiştiriniz.

ActiveSheet.Pictures.Insert("[COLOR="Red"][B]C:\Evren\Resimler\2.jpg[/B][/COLOR]").Select

Kodun tamamı.:

Sub Hucrede_Resim()
Dim i As Integer
For i = 1 To ActiveSheet.Shapes.Count
    If ActiveSheet.Shapes(i).Top = Range("C1").Top _
    And ActiveSheet.Shapes(i).Left = Range("C1").Left Then
        ActiveSheet.Shapes(i).Delete
    End If
Next i
ActiveSheet.Pictures.Insert("C:\Evren\Resimler\2.jpg").Select
Selection.Top = Range("C1").Top
Selection.Left = Range("C1").Left
Range("A1").Select
End Sub

 

[mbattal]

Hocam sadece C1 hücresine mi getiriyor
mesala
A1, B1, C1, D1, E1 daha sonra
A3, B3, C3, D3, E3
A5, B5. C5, D5, E5 gibi 2 satır atlaya atlaya isimlerini girersek girdiğimiz isimlere ait resimler gelir mi
Yani tek sayfa üzerinde yüzlerce resim gözükebilirmi

Yada A1 e ismi yazılan resim B1 de gözüksün, A2 ye yazılan B2 DE, A3 e yazılan B3 te gibi aşağıya doğru gidecek gibi

 

[Orion1]

Hocam sadece C1 hücresine mi getiriyor
mesala
A1, B1, C1, D1, E1 daha sonra
A3, B3, C3, D3, E3
A5, B5. C5, D5, E5 gibi 2 satır atlaya atlaya isimlerini girersek girdiğimiz isimlere ait resimler gelir mi
Yani tek sayfa üzerinde yüzlerce resim gözükebilirmi

Yada A1 e ismi yazılan resim B1 de gözüksün, A2 ye yazılan B2 DE, A3 e yazılan B3 te gibi aşağıya doğru gidecek gibi

Ekli dosyayı inceleyiniz.
Resim dosyalarınız jpg formatlı olması gerekiyor.
Aşağıda kırmızı renkli kodu kendi dosya yolunuza göre değiştiriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A3:E65536]) Is Nothing Then Exit Sub
If Target.Row Mod 2 = 0 Then Exit Sub
On Error GoTo hata
For i = 1 To ActiveSheet.Shapes.Count
    If ActiveSheet.Shapes(i).Left = Target.Offset(-1, 0).Left _
    And ActiveSheet.Shapes(i).Top = Target.Offset(-1, 0).Top Then
        ActiveSheet.Shapes(i).Delete
    End If
Next i
hata:
On Error GoTo son
ActiveSheet.Pictures.Insert("[COLOR="Red"][B]C:\Evren\Resimler\"[/B][/COLOR] & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(-1, 0).Top
Selection.Left = Target.Offset(-1, 0).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(-1, 0).Height
Selection.ShapeRange.Width = Target.Offset(-1, 0).Width
Target.Select
son:
End Sub

 

[tahsinanarat]

Sn. Evren Gizlen hocam, mbattal arkadaşın dediği gibi, a sutununda resim isimleri b sutununda resimleri göstermek istersek, kod nasıl olmalıdır.

 

[tahsinanarat]

bu şekilde değiştirdim, çalıştı, umarım doğrudur

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:z65536]) Is Nothing Then Exit Sub
If Target.Row Mod 2 = 2 Then Exit Sub
On Error GoTo hata
For i = 1 To ActiveSheet.Shapes.Count
If ActiveSheet.Shapes(i).Left = Target.Offset(0, 1).Left _
And ActiveSheet.Shapes(i).Top = Target.Offset(0, 1).Top Then
ActiveSheet.Shapes(i).Delete
End If
Next i
hata:
On Error GoTo son
ActiveSheet.Pictures.Insert("d:\foto\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 1).Top
Selection.Left = Target.Offset(0, 1).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 1).Height
Selection.ShapeRange.Width = Target.Offset(0, 1).Width
Target.Select
son:
End Sub
Sub Ekle_Nesne_TumSil()
ActiveSheet.DrawingObjects.Delete
End Sub

 

[mbattal]

Sayın Evren Hocam,
Verdiğiniz kodlar çok işime yaradı. İlginiz ve emeğiniz için tekrar teşekkür ederim.
Sayın tahsinanarat ın verdiği kodları çalıştıramadım

Saygılarımla

 

[Orion1]

Sayın Evren Hocam,
Verdiğiniz kodlar çok işime yaradı. İlginiz ve emeğiniz için tekrar teşekkür ederim.
Sayın tahsinanarat ın verdiği kodları çalıştıramadım

Saygılarımla

Rica ederim.
İyi çalışmalar.

 

[skywalker48]

bende şunu sorsam, resimleri direk hücrenin açıklamasına atsa, bu yapılabilirmi.?
mesela a3 hücresine mehmet yazarsam mehmetin fotosu çıksın, hüseyin yazarsam hüseyin çıksın,
sabit olarak eklemeyi mahmut arkadaşımızın kod bankasından öğrenmiştim.

 

[mbattal]

Sayın Evren Hocam,
Tekrar rahatsız ettiğim için özür dilerim. 10'uncu sırada vermiş olduğunuz kodu bir butona bağlayabilirmiyiz butona tıklayınca aktif olsun

Saygılarımla

 

[Orion1]

Sayın Evren Hocam,
Tekrar rahatsız ettiğim için özür dilerim. 10'uncu sırada vermiş olduğunuz kodu bir butona bağlayabilirmiyiz butona tıklayınca aktif olsun

Saygılarımla

Ekli dosyayı inceleyiniz.

 

[mbattal]

Hocam oluyor ama sadece mause ile seçtiğim isimlerin resimlerini açıyor diğerlerini açmıyor. Benim sayfamda yüzlerce isim olduğundan ve her biri tek tek mause ile seçilemeyeceğinden malesef kullanışlı olmuyor.
sizi çok uğraştırdım her şey için tekrar teşekkür ederim
Saygılarımla
Başarılarınızın devamını dilerim

 

[Orion1]

Hocam oluyor ama sadece mause ile seçtiğim isimlerin resimlerini açıyor diğerlerini açmıyor. Benim sayfamda yüzlerce isim olduğundan ve her biri tek tek mause ile seçilemeyeceğinden malesef kullanışlı olmuyor.
sizi çok uğraştırdım her şey için tekrar teşekkür ederim
Saygılarımla
Başarılarınızın devamını dilerim

Ben öyle istediğiniz bilmediğim için böyle yaptım.Bir uğraşayım bakalım ne olacak.

 

[tahsinanarat]

Sonucu bekliyoruz

Ben öyle istediğiniz bilmediğim için böyle yaptım.Bir uğraşayım bakalım ne olacak.

Sonuç merakla bekleniyor hocam.