Kod Sabit Sayı

Merhaba,
Muhtemelen bahsettiğiniz sabitleme olayını yanlış yerden düzenlemesini yaptınız.


Örneğinizdeki forma balyalama sayısı için alan ekledim.

Ayrıca her iki formda da düzenleme yapıldı.

Sn.ozanakkaya

Çok Teşekkürler Emeğinize Sağlık Buda Süper Olmuş

Sn.ozanakkaya

Kusura Bakmayın Bir Ricam Daha olacak Eğer mümkünse

-Her Balyada
-7 Evrak Sabit Her Balyada Reçete Aralığımız 148 - 153 aralığı yapmıştık
-Her Balyadaki Kutu Adeti de Toplamda 1 - 9 Kutu aralığında Olabilirmi Maximum
-Bunu Yapmak Mümkünmü

Emeğiniz ve Uğraşlarınız için Çok Teşekkür Ederim

Butondaki

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])")

kodunu aşağıdaki ile değiştir. Ancak bu şekilde uygun kayıt bulabileceğini sanmıyorum.

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])")

Sn.ozanakkaya

emeğiniz için teşekkür ederim

frm_balya Formundaki butona göndermiş olduğunuz kodu kopyalayıp değiştirdim.
Ama 9 un üstünde balyaladı kutuları

-Bir Balyada
-7 Evrak Eşit
-148 - 153 aralığında reçete
-En fazlada 9 kutu olsun istiyoruz

Emeğiniz için tekrar teşekkürler

Butonun tıklandığında olayındaki kodlar

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

Formun zaman dolduğunda olayındaki kodlar;

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