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