Diğer Sayfadan Resim Çekme (Resim Çağırma) Listesi

[mekist]

Merhabalar

Çok eski konu, kodu yazanlar aktif bile olmayabilir, makrolu olan dosyada A kolunu değişikliğe istinaden resimleri getiriyor
Gelmesini istediğimiz veriye ait bilgiyi silince resminde silinmesini bekledim ama silmedi, ben yapamamış olabilirin

Merhaba , her iki yöntem ile hazırlanmış dosyalar ektedir.

Makrosuz kullanılan da Ad tanımlaması yapılmıştır tek hücreye , her satır için çoğaltabilirsiniz.

Tavsiyem ve daha kullanışlı olarak gördüğüm makrolu olan çözüm dosyasıdır.

Makrosuz dosyada kullanılan ad tanımlama formülü

=DOLAYLI("RESİM!B"&KAÇINCI(BİLGİ!$A$2;RESİM!$A$2:$A$100;0)+1)

Kodlar

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A2:A1000")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target <> "" Then
        Dim Resim, adress, ResimAdi
        On Error Resume Next
        For Each Resim In ActiveSheet.Shapes
            adress = Resim.TopLeftCell.Row
            If Target.Row = adress Then
                Resim.Delete
                Exit For
            End If
    
        Next
        For Each Resim In Sheets("Resim").Shapes
            adress = Resim.TopLeftCell.Column
            If adress = 2 Then
                ResimAdi = Sheets("Resim").Cells(Resim.TopLeftCell.Row, 1).Value
                If ResimAdi = Target Then
                    Resim.Copy
                    ActiveSheet.Paste Destination:=Cells(Target.Row, 2)
                    With Cells(Target.Row, 2)
                        Selection.ShapeRange.LockAspectRatio = msoFalse
                        Selection.Height = .MergeArea.Height - 4
                        Selection.Width = .MergeArea.Width - 4
                        Selection.Top = .Top + 2
                        Selection.Left = .Left + 2
                        Selection.Placement = xlMoveAndSize
                    End With
                    Target.Select
                    Exit Sub
                End If
            End If
        Next
    End If

End Sub