- Katılım
- 26 Aralık 2011
- Mesajlar
- 164
- Excel Vers. ve Dili
- Office 2016
- Altın Üyelik Bitiş Tarihi
- 26-12-2024
Excel de aşağıda yaptığım kod sonrası tabloda resimler geliyor fakat TC numarasını değiştirdiğimde yeni resim ve yeni bilgiler geldiğinden (SX: X6 HÜCRESİNE) koyduğum logo siliniyor. Logo sabit kalması gerekli Bunu Nasıl Sabitleyebilirim..
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C13:R13]) Is Nothing Then Exit Sub
Dim p As Object, t As Double, l As Double, w As Double, h As Double
ResimDosya = ThisWorkbook.Path & "\Resimler\" & Target.Value & ".jpg"
If Dir(ResimDosya) = "" Then Exit Sub
For Each p In ActiveSheet.Pictures
p.Delete
Next
Set p = ActiveSheet.Pictures.Insert(ResimDosya)
With Range("L9:Q15") 'Cells(Target.Row, Target.Column - 2)
t = .Top
l = .Left
w = .Width '.Offset(0, .Columns.Count).Left - .Left
h = .Height '.Offset(.Rows.Count, 0).Top - .Top
End With
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C13:R13]) Is Nothing Then Exit Sub
Dim p As Object, t As Double, l As Double, w As Double, h As Double
ResimDosya = ThisWorkbook.Path & "\Resimler\" & Target.Value & ".jpg"
If Dir(ResimDosya) = "" Then Exit Sub
For Each p In ActiveSheet.Pictures
p.Delete
Next
Set p = ActiveSheet.Pictures.Insert(ResimDosya)
With Range("L9:Q15") 'Cells(Target.Row, Target.Column - 2)
t = .Top
l = .Left
w = .Width '.Offset(0, .Columns.Count).Left - .Left
h = .Height '.Offset(.Rows.Count, 0).Top - .Top
End With
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub