• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excelde resim düngüsü hk.

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
Merhaba arkadaşlar ekte örnek dosyamda olduğu gibi resim döngüsünde d hücresindeki sırada okul numarası yazdığımda , b hücresine tetikliyor. Benim yapmaya çalıştığım düngünün devamı olarak j hücresine okul numarası yazdığımda da h hücresine resim tetiklemesini istiyorum. dosya ektedir kullandığım kod ise
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [d:d]) Is Nothing Then Exit Sub

'hata kontrolü
On Error GoTo çıkış

'resimlleri sil
ActiveSheet.DrawingObjects.Delete

'resim yolunun bulunması

Dim Resimyolu As Variant
Dim Resim As Object

For satır = 3 To 50
'Resimyolu = ActiveWorkbook.Path & "\" & Range("d" & satır) & ".jpg"
Resimyolu = "c:\OKUL" & "\" & Range("d" & satır) & ".jpg"

'resmi oluştur
Set Resim = ActiveSheet.Pictures.Insert(Resimyolu)

'resmi boyutlandır

With Range("b" & satır)
Resim.Top = .Top + 5
Resim.Left = .Left + 2
Resim.Height = 45
Resim.Width = 45
End With
Next satır
çıkış:
End Sub
 

Ekli dosyalar

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
'---------------------1.ALAN------------------------------

Dim Resimyolu As Variant
Dim Resim As Object

If Not Intersect(Target, [d:d]) Is Nothing Then

'hata kontrolü
On Error GoTo çıkış

'resimlleri sil
ActiveSheet.DrawingObjects.Delete

'resim yolunun bulunması
For satır = 3 To 50
'Resimyolu = ActiveWorkbook.Path & "\" & Range("d" & satır) & ".jpg"
Resimyolu = "c:\OKUL" & "\" & Range("d" & satır) & ".jpg"

'resmi oluştur
Set Resim = ActiveSheet.Pictures.Insert(Resimyolu)

'resmi boyutlandır

With Range("b" & satır)
Resim.Top = .Top + 5
Resim.Left = .Left + 2
Resim.Height = 45
Resim.Width = 45
End With
Next satır
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''
If Intersect(Target, [j:j]) Is Nothing Then Exit Sub

'hata kontrolü
On Error GoTo çıkış

'resimlleri sil
ActiveSheet.DrawingObjects.Delete

'resim yolunun bulunması

For satır = 3 To 50
'Resimyolu = ActiveWorkbook.Path & "\" & Range("d" & satır) & ".jpg"
Resimyolu = "c:\OKUL" & "\" & Range("j" & satır) & ".jpg"

'resmi oluştur
Set Resim = ActiveSheet.Pictures.Insert(Resimyolu)

'resmi boyutlandır

With Range("h" & satır)
Resim.Top = .Top + 5
Resim.Left = .Left + 2
Resim.Height = 45
Resim.Width = 45
End With
Next satır

çıkış:
End Sub
 
Rica ederim hayırlı geceler
 
Geri
Üst