resımlerı fılıtreleme

[esad45]

Merhaba bir excel dosyam var klosorumde resımlerı otomatık olark klosorden alıyorum ama resımlerı fılıtreleme yaparken resımler sekılden sekıle gırıyor bu formule daha ne eklemelıyım resımler suz ozellıgınde hucreye sıgması ıcın ve duzgun calısması ıcın


Private Sub Worksheet_Change(ByVal Target As Range)


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


On Error GoTo Çıkış:


ActiveSheet.DrawingObjects.Delete

Dim ResimDosyaYolu As String
Dim Resim As Object


For i = 3 To 1200

ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("b" & i) & ".jpg"


If DosyaVarmi(ResimDosyaYolu) Then
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("b" & i) & ".jpg"
Else
ResimDosyaYolu = ActiveWorkbook.Path & "\yok.jpg"
End If



Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)

With Range("a" & i)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With

Next i

Çıkış:

End Sub

 

[muygun]

Merhaba;
Makronuzda hem sayfada tetikleme hem de döngü kullanmışsınız.
Bunun yerine B sütununda işlem varsa işlem yapılması daha mantıklı
Eki deneyin. (ekli dosyayı resimlerin olduğu klasöre kaydedip açın)
İyi çalışmalar.

Link:

Hata indir

Hata

www.dosyaupload.com

NOT: Örnek dosya olmayınca çok bilinmeyen askıda kalıyor...