Pessoal, estou criando um sistema que realize sorteio aleatório de peças, as peças são classificadas de A até E, serão sempre sorteadas 100 peças por mes, sendo que dessas peças 51 precisam ser A e B e 49 C, D e E, as peças só podem ser repetidas se todas da mesma classificação já tiverem sido sorteadas, já pesquisei nas perguntas anteriores mas não achei nada parecido, e não consegui abrir o exemplo de bingo do JPaulo. Segue o código que estou tentando adaptar. Obrigada a todos.
- Código:
Option Compare Database
Option Explicit
' Essa função será chamada quando todas as peças tiverem sido sorteadas
Private Function MudaSorteada()
Dim db As Database, rs As Recordset, rx As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("AB", dbOpenDynaset)
Set rx = db.OpenRecordset("CDE", dbOpenDynaset)
db.Execute "UPDATE AB SET Sorteada='" & "Não" & "'" 'Muda o campo Sorteada de todas as peças para "Não"
db.Execute "UPDATE CDE SET Sorteada='" & "Não" & "'"
rs.Close
rx.Close
Set rs = Nothing
Set db = Nothing
Set rx = Nothing
End Function
Private Sub Form_Load()
Dim Alea As Long, Cond As String
If DCount("*", "AB", "Sorteada='" & "Sim" & "'") < 51 Then
Do
Alea = Int(Rnd() * DMax("COD", "AB")) + 1
If DLookup("Sorteada", "AB", "COD=" & Alea) = "Sim" Then
Cond = "False"
Else
Cond = "true"
End If
Loop Until Cond = "true"
txtID_ITEM = DLookup("ID_ITEM", "AB", "COD=" & Alea)
TxtABC = "Classe " & DLookup("ABC", "AB")
If DCount("*", "CDE", "Sorteada='" & "Sim" & "'") < 49 Then
Do
Alea = Int(Rnd() * DMax("COD", "CDE")) + 1
If DLookup("Sorteada", "CDE", "COD=" & Alea) = "Sim" Then
Cond = "False"
Else
Cond = "true"
End If
Loop Until Cond = "true"
ID_ITEM = DLookup("ID_ITEM", "CDE", "COD=" & Alea)
ABC = "Classe " & DLookup("ABC", "CDE")
Dim db2 As Database, rs2 As Recordset, db3 As Database
Set db2 = CurrentDb()
Set db3 = CurrentDb()
db2.Execute "UPDATE AB SET Sorteada='" & "Sim" & "' WHERE COD = " & Alea & ";"
db3.Execute "UPDATE CDE SET Sorteada='" & "Sim" & "' WHERE COD = " & Alea & ";"
Set rs2 = Nothing
Set db2 = Nothing
Set db3 = Nothing
If DCount("*", "AB", "Sorteada='" & "Sim" & "'") = DCount("*", "AB") Then
Call MudaSorteada
End If
If DCount("*", "CDE", "Sorteada='" & "Sim" & "'") = DCount("*", "CDE") Then
Call MudaSorteada
End If
Else
Exit Sub
End If
End If
End Sub
Última edição por fermoraisc em 6/3/2018, 11:32, editado 3 vez(es)