klasördeki fotoğrafları tabloya yerleştirme

[fayata]

Herkese merhaba,

Not defteri ile ilgili bir sıkıntım var. Bu konuda yardımcı olursanız çok minnettar kalırım.

Excel de öğretmen not defteri dizaynı yaptım. Bu dizayna klasörde bulunan fotoğrafların atanması gerekiyor.

Ekteki dosyada elle yaptığım nasıl olmasını gerektiği hakkında örnek var. Fotoğrafların altında öğrencinin no, isim, soyisim, bilgilerinin de yer alması gerekiyor ( bu bilgiler aynı zamanda dosya ismi; "232 Fatih Kundura.jpg" gibi).

klasördeki fotoğraflar;

232 fatih kundura.jpg
314 sinem sen.jpg
526 furkan koptagel.jpg
...

şeklinde

ve bu fotoğrafların numara sırasına göre tablo ya yerleştirilmesi gerekiyor.

tablo da sayfalarda harmanlama usulüne göre yerleştirilmiş durumda. İlk önce sayfa 1 sonra sayfa no suna göre yerleşmeli.

"Ben yaparım" diyen arkadaşım telefonlarını açmadığından çok büyük sıkıntıya girmiş durumdayım ve iş te çok acil. Şimdiden yardımcı olacak, fikir verecek tüm arkadaşlara teşekkür ederim.

Saygı ve sevgilerimle

 

[fayata]

yok mu bir bilen ?

 

[tahsinanarat]

Resim yolunu değiştirerek aşağıdaki kodları deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:BS65536]) Is Nothing Then Exit Sub
If Target.Row Mod 5 = 0 Then Exit Sub
On Error GoTo hata
For i = 1 To ActiveSheet.Shapes.Count
If ActiveSheet.Shapes(i).Left = Target.Offset(-1, 0).Left _
And ActiveSheet.Shapes(i).Top = Target.Offset(-1, 0).Top Then
ActiveSheet.Shapes(i).Delete
End If
Next i
hata:
On Error GoTo son
ActiveSheet.Pictures.Insert("O:\Fotolar\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(-1, 0).Top
Selection.Left = Target.Offset(-1, 0).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 58
Selection.ShapeRange.Width = 49
Target.Select
son:
End Sub

Sub Belirli_Bir_Alandaki_Sekilleri_Sil()
Dim sekiL As Shape
For Each sekiL In ActiveSheet.Shapes
If Not Intersect(sekiL.TopLeftCell, Range("a1:bs65000")) Is Nothing Then
sekiL.Delete
End If
Next
End Sub

 

[fayata]

Tahsin bey,

Öncelikle ilginiz için teşekkür ederim.

Sanırım yanlış bir şey yapıyorum; verdiğiniz kodları makro açarak içine yapıştırdım, daha sonra

ActiveSheet.Pictures.Insert("O:\Fotolar\" & Target.Value & ".jpg").Select

satırını

ActiveSheet.Pictures.Insert("C:\Fotolar\" & Target.Value & ".jpg").Select

şeklinde değiştirdim. C ye "fotolar" şeklinde klasör açıp içine fotoları ekledim.

çalıştır dediğimde birşey değişmedi. Nerde hata yaptığımı yazarsanız memnun olurum.

Saygılarımla,

 

[fayata]

Tahsin bey,

var olan fotoğrafları siliyor ama klasörden fotoğraf almıyor.

 

[tahsinanarat]

Fotoğrafların bulunduğu dosya yolunu bana gönderebilirmisiniz, bende herhangi bir hata vermiyor.
Not. kodlar sayfanın kod bölümüne yapıştırılacaktır.

 

[fayata]

"C:\FOTOLAR" klasörüde *.jpg şeklinde dosyalar

 

[fayata]

Dosya ismi tam yazıldığında fotoğraflar geliyor. Tahsin beye ilgisinden dolayı çok çok teşekkür ederim.

Saygılarımla,

F.Ayata