Resim Getirme

[mars2]

İyi Günler,

Aşağıdaki kod ile resimleri getirtebiliyorum ancak, klasörün "D" ninn içinde olması gerekiyor. Benim istediği ise bu klasörün bilgisayarın C, D E,F... de olması fark etmeden kodda değişiklik yaparak getirtebiliriz.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Local Error Resume Next
If Target.Address = "$B$" & ActiveCell.Row And Target.Value <> Empty Then
If ActiveSheet.Shapes.Count > 0 Then ActiveSheet.Shapes(1).Delete
ActiveSheet.Shapes.AddPicture "D:\belgeler\LİSTE\Resimler\" & Target.Value & ".jpg" & hucre, True, True, 200, 0, 125, 125
Else
For Each shp In ActiveSheet.Shapes
shp.Delete
Next
End If
End Sub

 

[mars2]

Arkadaşlar;
İlginize teşekkürler, Konuyu anlatamamış olabilirim. Yukardaki formülde sadece Bilgisayarın D bölümündeki belgelerde çalışmakta, ben ise iser D bölümü olsun veya farkı bir yerde olsun veya bir başka bilgisayar götürdüğümde çalışmasını istiyorum.

 

[Merhum İdris SERDAR]

Aşağıdaki şekilde deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Local Error Resume Next
[COLOR="Red"]Dim Resimyolu As String
Resimyolu = ThisWorkbook.Path & "\"[/COLOR]
If Target.Address = "$B$" & ActiveCell.Row And Target.Value <> Empty Then
If ActiveSheet.Shapes.Count > 0 Then ActiveSheet.Shapes(1).Delete
ActiveSheet.Shapes.AddPicture "[COLOR="red"]Resimyolu[/COLOR]" & Target.Value & ".jpg" & hucre, True, True, 200, 0, 125, 125
Else
For Each shp In ActiveSheet.Shapes
shp.Delete
Next
End If
End Sub

.