Set SrgYp = CurrentDb.CreateQueryDef("srg_balyalanacakkayitlar", "SELECT TOP " & Me.mtn_balyasayisi & " Evrak_No, [Reçete Sayısı], tarandı, [Balya No], Grubu FROM Eczacılık WHERE (((tarandı) Is Null) And ((Grubu) = '" & Me.acl_grubu & "')) ORDER BY Rnd(Int(Now()*[Evrak_No])-Now()*[Evrak_No])")

Set SrgYp = CurrentDb.CreateQueryDef("srg_balyalanacakkayitlar", "SELECT TOP " & Me.mtn_balyasayisi & " Evrak_No, [Reçete Sayısı], tarandı, [Kutu Adedi], [Balya No], Grubu FROM Eczacılık WHERE    (((tarandı) Is Null) And ((Grubu) = '" & Me.acl_grubu & "') AND (([Kutu Adedi]) Between 1 And 9)) ORDER BY Rnd(Int(Now()*[Evrak_No])-Now()*[Evrak_No])")

Private Sub btn_balyala_Click()

If Me.btn_balyala.Caption = "Balyala" Then

    GSorguKontrol = Nz(DCount("*", "MSysObjects", "[Name] = 'srg_balyalanacakkayitlar'"), 0)
    If GSorguKontrol <> 0 Then
    
        DoCmd.DeleteObject acQuery, "srg_balyalanacakkayitlar"
    
    End If
    
    Set SrgYp = CurrentDb.CreateQueryDef("srg_balyalanacakkayitlar", "SELECT TOP " & Me.mtn_balyasayisi & " Evrak_No, [Reçete Sayısı], tarandı, [Kutu Adedi], [Balya No], Grubu FROM Eczacılık WHERE (((tarandı) Is Null) And ((Grubu) = '" & Me.acl_grubu & "')) ORDER BY Rnd(Int(Now()*[Evrak_No])-Now()*[Evrak_No])")
    
    GBalyaSon = Mid(mtn_balyasayisi, Len(mtn_balyasayisi), Len(mtn_balyasayisi))
    
    
    If GBalyaSon = "2" Or GBalyaSon = "7" Then
    GGek = "şerli"
    ElseIf GBalyaSon = "6" Then
    GGek = "şarlı"
    ElseIf GBalyaSon = "9" Or GBalyaSon = "0" Then
    GGek = "arlı"
    Else
    GGek = "erli"
    End If
    
    
    Dim db As Database
    Dim rst As Recordset
    
    Set db = CurrentDb()
    Set rst = db.OpenRecordset("srg_balyalanacakkayitlar")
    
    rst.MoveLast
            
    Me.mtn_kontrol = rst.RecordCount
    
    
    
    If MsgBox(Me.acl_grubu & " Grubuna Ait Reçetelerin " & Me.mtn_balyasayisi & "'" & GGek & " balyalanmasını istiyor musunuz", vbYesNo) = vbYes Then
    
        If Nz(DMax("[Balya No]", "Yapılan_Balyalar"), 0) = 0 Then
    
        BalyaNo = InputBox("A Gurubu başlangıçtaki balya numarasını giriniz...")
        Else
        BalyaNo = DMax("[Balya No]", "Yapılan_Balyalar") + 1
        End If
        
        Me.mtn_balyano = "Balya No: " & BalyaNo
        Me.TimerInterval = 100
    End If
    
Me.btn_balyala.Caption = "Durdur"

ElseIf Me.btn_balyala.Caption = "Durdur" Then
    Me.TimerInterval = 0
    Me.btn_balyala.Caption = "Balyala"
    Exit Sub
End If

End Sub

Private Sub Form_Timer()


100

Dim db As Database
Dim rst As Recordset

Set db = CurrentDb()
Set rst = db.OpenRecordset("srg_balyalanacakkayitlar")

rst.MoveLast
        
Me.mtn_kontrol = rst.RecordCount

mtn_balyasayisi.Requery

If Val(Me.mtn_kontrol) < Val(Me.mtn_balyasayisi) Then

MsgBox (mtn_kontrol & "-" & mtn_balyasayisi)

MsgBox " Balyalama işlemi sona erdi. Tabloda balya yapılmamış gurup varsa eczane sayısını artırarak yeniden deneyebilirsiniz."

Me.TimerInterval = 0
Exit Sub

ElseIf Val(Me.mtn_kontrol) > Val(Me.mtn_balyasayisi) Then

GoTo 100

End If

rst.MoveFirst

Do While Not rst.EOF
 
    GToplam = GToplam + rst![Reçete Sayısı]
    GEvrakNo = GEvrakNo & "," & rst![Evrak_No]
   
    rst.MoveNext
    
Loop
     Me.mtn_kayittoplam = GToplam
     Me.mtn_evraknumaralari = Mid(GEvrakNo, 2, Len(GEvrakNo))
     Me.Metin40 = Dsum ("[Kutu Adedi]", "srg_balyalanacakkayitlar")
     For xx = 1 To 10
          
        A = 148 * xx
        B = 153 * xx
        
       If GToplam > A And GToplam < B Then
         
            If Dsum ("[Kutu Adedi]", "srg_balyalanacakkayitlar") < 10 Then
               
               MsgBox (DSum("[Kutu Adedi]", "srg_balyalanacakkayitlar"))
               
               For z = 1 To 10
               
               Controls("Metin" & z).BackColor = vbWhite
               
               Next z
                
               Controls("Metin" & xx).BackColor = vbYellow
                            
               DoCmd.SetWarnings False
               DoCmd.RunSQL "UPDATE Eczacılık SET tarandı = '1', [Balya No] = " & BalyaNo & " WHERE (((Evrak_No) In (" & Me.mtn_evraknumaralari & ")))"
               DoCmd.SetWarnings True
               Me.mtn_balyalanmayan = "Balyalanmayan Evrak Sayısı : " & DCount("*", "Eczacılık", "[Grubu]=  '" & Me.acl_grubu & "' And [Balya No] Is Null")
        
               BalyaNo = BalyaNo + 1
               mtn_sayim = 1
               
               Me.mtn_balyano = "Balya No: " & BalyaNo
               
               Exit For
               Exit Sub
            End If
       End If
        
     Next xx
     
     Me.mtn_sayim = Nz(Me.mtn_sayim, 0) + 1

    If Me.mtn_sayim > 5000 Then
        MsgBox ("Balyanacak uygun reçete bulunamadı")
        Me.TimerInterval = 0
        Exit Sub
    End If
     
    
    rst.Close

End Sub