Private Sub BtnEgitEkle_1_Click()



Dim VrdRS As New ADODB.Recordset

Dim GunRS As New ADODB.Recordset



Dim x, xTarih As Long

Dim VrdSrg, VrdSrgB, GunSrg, KriterMod As String



Dim BasTrh, BitTrh, Modx As Long

Dim ModAdi As String

Dim ModSec() As String



ModSec = Split("4A;4B;4C;4D", ";")

BasTrh = CLng(DateSerial(2020, 2, 1))

BitTrh = CLng(DateSerial(2020, 3, 0))

Modx = CLng(DateSerial(2020, 1, 3))



VrdSrgB = " SELECT liste.Kimlik, liste.vardiya " & _

        " FROM TblTmpVrdy INNER JOIN (liste LEFT JOIN TblEgtm ON liste.Kimlik = TblEgtm.Kisi) ON " & _

        " TblTmpVrdy.Vardiya = liste.vardiya " & _

        " WHERE (((TblEgtm.Kisi) Is Null) AND ((Month([tarih]))=2)"





CurrentDb.Execute "delete from TblTmpVrdy"



'hy_vardiya tablosuna GÜN ve Vardiya ekleme____________________________

For x = BasTrh To BitTrh

    y = DateDiff("d", Modx, x) Mod (24)

    If y > 17 Then ModAdi = "B"

    If y > 11 And y < 18 Then ModAdi = "A"

    If y < 12 Then ModAdi = "D"

    If y < 6 Then ModAdi = "C"

    If InStr(1, "67", Weekday(x, 0)) = 0 Then _

        CurrentDb.Execute " insert into TblTmpVrdy (VardiyaTrh,Vardiya) values (" & x & ",'4" & ModAdi & "')"

Next x

'hy_vardiya tablosuna GÜN ve Vardiya ekleme____________________________BİTTİ



'hy_Eğitim tablosuna KİŞİ ekleme____________________________

ModBas = LBound(ModSec)

modBit = UBound(ModSec)



For x = ModBas To modBit

'hy_Moda_Göre_Günler_Sorgusu_______________________________________________

    GunSrg = " SELECT TblTmpVrdy.VardiyaTrh, TblTmpVrdy.Vardiya " & _

            " FROM TblTmpVrdy " & _

            " WHERE (((TblTmpVrdy.Vardiya)='" & ModSec(x) & "'));"

    GunRS.Open GunSrg, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    

'hy_Moda_Göre_Kişiler_Sorgusu_______________________________________________

    KriterMod = " AND ((liste.vardiya)='" & ModSec(x) & "')) " & _

                " GROUP BY liste.Kimlik, liste.vardiya "

    VrdSrg = VrdSrgB & KriterMod

    VrdRS.Open VrdSrg, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    

    Do While VrdRS.RecordCount > 0

    If GunRS.EOF Then GunRS.MoveFirst

                VrdRS.MoveFirst

                

                CurrentDb.Execute " insert into TblEgtm (Gun, Kisi) values (" & CLng(GunRS(0)) & "," & VrdRS(0) & ")"

                VrdRS.Requery

    GunRS.MoveNext



    Loop

    VrdRS.Close

    GunRS.Close

Next x

'hy_Eğitim tablosuna KİŞİ ekleme____________________________BİTTİ

MsgBox "Eğitim Dağıtımı tamamlandı"



End Sub

eğitim_planı_hy3.rar (Dosya Boyutu: 32,72 KB | İndirme Sayısı: 5)