Çağırılan resmi excele kaydetmek

[yarbayasar]

Merhabalar,

Ben aşağıdaki makroyu kullanıyorum.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A8:L" & Cells(65536, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
On Error Resume Next
Range("A8:L65536").Interior.ColorIndex = xlNone
Range("A8:L65536").Font.Color = vbBlack
Range("A8:L65536").Font.Bold = False
Range("A" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 16
Range("A" & Target.Row & ":L" & Target.Row).Font.Bold = True
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbWhite
Image1.Left = Range("A1").Left
Image1.Top = Target.Top + Target.Height
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture("\\192.168.2.10\Sentez\Shop\resim\S" & _
Cells(Target.Row, "A").Value & ".jpg")
End Sub

İstediğim çağırdığım resimleri excelin içine kayıt etmek.Dosyayı yolladığımda karşımdakide o resmi görebilmeli.

 

[yarbayasar]

Merhabalar,

Ben aşağıdaki makroyu kullanıyorum.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A8:L" & Cells(65536, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
On Error Resume Next
Range("A8:L65536").Interior.ColorIndex = xlNone
Range("A8:L65536").Font.Color = vbBlack
Range("A8:L65536").Font.Bold = False
Range("A" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 16
Range("A" & Target.Row & ":L" & Target.Row).Font.Bold = True
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbWhite
Image1.Left = Range("A1").Left
Image1.Top = Target.Top + Target.Height
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture("\\192.168.2.10\Sentez\Shop\resim\S" & _
Cells(Target.Row, "A").Value & ".jpg")
End Sub

İstediğim çağırdığım resimleri excelin içine kayıt etmek.Dosyayı yolladığımda karşımdakide o resmi görebilmeli.
Şimdiden teşekkürler