kadir78
Altın Üye
- Katılım
- 6 Nisan 2016
- Mesajlar
- 227
- Excel Vers. ve Dili
- office 2019
- Altın Üyelik Bitiş Tarihi
- 30-12-2026
aşağıdaki kodlamada kırmızı yazı olan yerde Sayfa1 - B9 hücresindeki rakamla klasör içerisinden resim çağırıyor fakat b10 hücresinini başka bir çalışma sayfasının Sayfa 2 - B10 hücresine aktarma yapamadım. yardımcı olursanız sevinirim. iyi günler.
Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B9:B10]) Is Nothing Then Exit Sub
Dim p As Object, t As Double, l As Double, w As Double, h As Double
ActiveSheet.Pictures.Delete
ResimDosya = "C:\Resimler" & "\" & Target.Value & ".jpg"
If Dir(ResimDosya) = "" Then Exit Sub
Set p = ActiveSheet.Pictures.Insert(ResimDosya)
With Target.Offset(0, 1)
t = .Top + 3
l = .Left + 3
w = .Width - 3
h = .Height - 3
End With
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub
Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B9:B10]) Is Nothing Then Exit Sub
Dim p As Object, t As Double, l As Double, w As Double, h As Double
ActiveSheet.Pictures.Delete
ResimDosya = "C:\Resimler" & "\" & Target.Value & ".jpg"
If Dir(ResimDosya) = "" Then Exit Sub
Set p = ActiveSheet.Pictures.Insert(ResimDosya)
With Target.Offset(0, 1)
t = .Top + 3
l = .Left + 3
w = .Width - 3
h = .Height - 3
End With
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub