makroda resim çağırma

[alprn]

merhaba
ekteki dosyada model hücresinin yanındaki G1 J1 ve devamı şeklinde çoğaltarak sırasıyla resim çağırmak istiyorum ama bir türlü yapamadım.Yardımcı olabilirseniz sevinirim.

 

[alprn]

yardım lütfen

 

[Orion1]

Dosyanız ektedir.

Sub resimal_59()
Dim rsm As Object
For Each rsm In ActiveSheet.Pictures
    rsm.Delete
Next
If Range("G1").Value <> "" Then
    If Dir(ThisWorkbook.Path & "\" & Range("G1").Value & ".png") > "" Then
        Set rsm = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("G1").Value & ".png")
        rsm.ShapeRange.LockAspectRatio = msoFalse
        rsm.Top = Range("F38").Top
        rsm.Left = Range("F38").Left
        rsm.Height = Range("F38").Height
        rsm.Width = Range("F38").Width + Range("G38").Width + Range("H38").Width
    End If
End If
If Range("J1").Value <> "" Then
    If Dir(ThisWorkbook.Path & "\" & Range("J1").Value & ".png") > "" Then
        Set rsm = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("J1").Value & ".png")
        rsm.ShapeRange.LockAspectRatio = msoFalse
        rsm.Top = Range("I38").Top
        rsm.Left = Range("I38").Left
        rsm.Height = Range("I38").Height
        rsm.Width = Range("I38").Width + Range("J38").Width + Range("K38").Width
    End If
End If
If Range("M1").Value <> "" Then
    If Dir(ThisWorkbook.Path & "\" & Range("M1").Value & ".png") > "" Then
        Set rsm = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("M1").Value & ".png")
        rsm.ShapeRange.LockAspectRatio = msoFalse
        rsm.Top = Range("L38").Top
        rsm.Left = Range("L38").Left
        rsm.Height = Range("L38").Height
        rsm.Width = Range("L38").Width + Range("M38").Width + Range("N38").Value
    End If
End If

End Sub

 

[alprn]

Dosyanız ektedir.

Sub resimal_59()
Dim rsm As Object
For Each rsm In ActiveSheet.Pictures
    rsm.Delete
Next
If Range("G1").Value <> "" Then
    If Dir(ThisWorkbook.Path & "\" & Range("G1").Value & ".png") > "" Then
        Set rsm = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("G1").Value & ".png")
        rsm.ShapeRange.LockAspectRatio = msoFalse
        rsm.Top = Range("G1").Top
        rsm.Left = Range("G1").Left
        rsm.Height = Range("G1").Height
        rsm.Width = Range("G1").Width + Range("G1").Width
    End If
End If
If Range("J1").Value <> "" Then
    If Dir(ThisWorkbook.Path & "\" & Range("J1").Value & ".png") > "" Then
        Set rsm = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("J1").Value & ".png")
        rsm.ShapeRange.LockAspectRatio = msoFalse
        rsm.Top = Range("J1").Top
        rsm.Left = Range("J1").Left
        rsm.Height = Range("J1").Height
        rsm.Width = Range("J1").Width + Range("K1").Width
    End If
End If
If Range("M1").Value <> "" Then
    If Dir(ThisWorkbook.Path & "\" & Range("M1").Value & ".png") > "" Then
        Set rsm = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("M1").Value & ".png")
        rsm.ShapeRange.LockAspectRatio = msoFalse
        rsm.Top = Range("M1").Top
        rsm.Left = Range("M1").Left
        rsm.Height = Range("M1").Height
        rsm.Width = Range("M1").Width + Range("N1").Width
    End If
End If

End Sub

Hocam öncelikle cevap için çok teşekkür ederim
cahilliğimin kusuruna bakmayın ama benim istediğim g1 hücresine yazdığım ürün kodunun f38 hücresinde görünmesi acaba bu konuda yardım edebilir misiniz?

 

[Orion1]

Hocam öncelikle cevap için çok teşekkür ederim
cahilliğimin kusuruna bakmayın ama benim istediğim g1 hücresine yazdığım ürün kodunun f38 hücresinde görünmesi acaba bu konuda yardım edebilir misiniz?

#3 nolu mesajı tekrar güncelledim.
Dosyayı oradan indirebilirsiniz.

 

[alprn]

#3 nolu mesajı tekrar güncelledim.
Dosyayı oradan indirebilirsiniz.

hocam tekrar rahatsız ediyorum ama denedim olmuyor dosyayı tekrar gönderdim bakabilir misiniz?

 

[Orion1]

Benim yazdığım kodlar yok.Çalışmaz.
Önceki yolladığım dosyada buton vardı ,ona tıklayın.resimleri getirecek.

 

[alprn]

Benim yazdığım kodlar yok.Çalışmaz.
Önceki yolladığım dosyada buton vardı ,ona tıklayın.resimleri getirecek.

hocam tamamdır hallettim çok teşekkür ederim Allah razı olsun saygılar