Arkadaşlar hayırlı akşamlar
Elimdeki Excel dosyasında sayfa1 de A sütununda yazılan değeri /GÖNDERİLECEK RESİMLER/ klasöründe varsa dosya yolunu E Sütunan yazdırılacak. ve aynı şekilde Sayfa2 de düşey ara ile A ve B sütunlarını Sayfa1 de B ve C sütunlarına getirmesini istiyorum. Şimdiden Teşekkürler

https://s6.dosya.tc/server2/a0whpv/Yeni_klasor.rar.html

Merhaba.
Formülle resim olayını bilmiyorum.
Kod ile isterseniz ekte.Sayfada değişiklik durumunda çalışır.
Butona tıklama olatınada çavrilir yada kullanıcı tanımlı fonksiyonada çevrilebilir.


https://resim.accesstr.net/do.php?img=11048

Private Sub Worksheet_Change(ByVal Target As Range)

Dim bul As Range, i As Long

Dim bulResim As String



With Sayfa3

    If Not Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then

        If Target.Rows.Count = 1 Then

            If Target.Value = "" Then

                Range(Cells(Target.Row, "B"), Cells(Target.Row, "E")).Value = "": Exit Sub

            End If

        End If



        If Target.Rows.Count = 1 Then

            Set bul = .Range("C:C").Find(Target.Value, , , 1)

            bulResim = noVarmi(Target.Value)

            If bulResim <> "" Then Target.Offset(, 4).Value = bulResim Else Target.Offset(, 4).Value = "Resim bulunamadý"

            If Not bul Is Nothing Then

                Range("B" & Target.Row & ":C" & Target.Row).Value = .Range("G" & bul.Row & ":H" & bul.Row).Value

            Else

                Range("B" & Target.Row & ":C" & Target.Row).Value = ""

            End If

        ElseIf Target.Rows.Count > 1 Then

            For i = Selection.Row To Target.Rows.Count + Selection.Row

                Set bul = .Range("C:C").Find(Cells(i, "A").Value, , , 1)

                bulResim = noVarmi(Cells(i, "A").Value)

                If bulResim <> "" Then

                    Cells(i, "E").Value = bulResim

                Else

                    If Cells(i, "A").Value = "" Then

                        Cells(i, "E").Value = ""

                    Else

                        Cells(i, "E").Value = "Resim bulunamadý"

                    End If

                End If

                

                If Not bul Is Nothing Then

                  Cells(i, "B").Value = .Range("G" & bul.Row)

                  Cells(i, "C").Value = .Range("H" & bul.Row)

                Else

                    Range(Cells(i, "B"), Cells(i, "C")).Value = ""

                End If

            Next

        End If

    End If

End With

Set bul = Nothing

End Sub

Function noVarmi(aranan) As String

Dim dosya As String, yol As String, parca As String

If CStr(aranan) = "" Then

    noVarmi = "": Exit Function

End If

parca = ThisWorkbook.Path & Application.PathSeparator & "GNDERLECEK RESMLER" & Application.PathSeparator

dosya = Dir(parca & "*.*")

noVarmi = ""

Do While dosya <> ""

    If dosya Like "*" & aranan & "*" Then

        noVarmi = parca & dosya: Exit Function

    End If

    dosya = Dir

Loop

End Function

Konu cevaplanmışlara taşınmıştır.

Sayın feraz bey
Teşekkürler. Konu çözüme kavuşturulmuştur.