bahsettiğiniz talebinize yönelik olarak en son eklediğiniz uygulamanız çalıştırılmak sureti ile yapılan çalışma neticesinde;
frm_okulKararim adlı formunuzdaki excele gönderme butonunun içeriğinde yapılan gerekli düzenlemeler sonucu elde edilen geçerli kodlama aşağıdaki gibidir.
bu düzenleme için, SADECE frm_okulKararim adlı formunuz kullanılmıştır.bu sebeple,denemede bulunup sonucu olumlu gördüğünüz takdirde,lütfen benzer kodlama düzenlemelerini diğer belirttiğiniz 3 adet formunuzdaki kodlara da uyarlayınız.
talep edildiğinde,bu işlemin uygulandığı örnek uygulama konunuza dahil edilecektir.bilginize.
Kod:
Private Sub Komut45_Click()
Dim SQL As String
Dim db As Database
Dim rs As DAO.Recordset
Dim rt As DAO.Recordset
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open("E:\okul.xlsx")
Set oSheet = oBook.Worksheets(1)
For i = 33 To 54
oSheet.Cells(i, 19).Value = 0
oSheet.Cells(i, 20).Value = 0
oSheet.Cells(i, 21).Value = 0
oSheet.Cells(i, 22).Value = 0
' oSheet.Cells(i, 23).Value = 0
' oSheet.Cells(i, 24).Value = 0
Next i
Set db = CurrentDb()
SQL = "SELECT * FROM okulkarari"
Set rs = db.OpenRecordset(SQL)
If rs.EOF = True Then Exit Sub
rs.MoveFirst
Do Until rs.EOF = True
For i = 33 To 54
If oSheet.Cells(i, 18).Value = rs!egitselokulkarari Then GoTo 110
Next i
MsgBox rs!egitselokulkarari & " Excelde bulunamadı..."
GoTo 100
110
SQL = "SELECT * FROM tbl_hepsi"
Set rt = db.OpenRecordset(SQL)
If rt.EOF = True Then Exit Sub
rt.MoveFirst
K1 = 0
E1 = 0
Do Until rt.EOF = True
If rt!randevu < Me.iltarih Then GoTo 120
If rt!randevu > Me.sontarih Then GoTo 120
If rs!egitselokulkarar_id = rt!egitselokul_karari Then
If rt!cinsiyet = 1 Then K1 = K1 + 1
If rt!cinsiyet = 2 Then E1 = E1 + 1
End If
120
rt.MoveNext
Loop
oSheet.Cells(i, 19).Value = K1
oSheet.Cells(i, 20).Value = E1
oSheet.Cells(i, 23).Value = K1
oSheet.Cells(i, 24).Value = E1
rs.MoveNext
Loop
MsgBox "Excel dosyanız güncellenmiştir..."
100
oBook.Save
oBook.Close
oExcel.Quit
End Subiyi çalışmalar,
saygılar.
