Código VBA comentado do
ArquivoSorteio_MinhaCasaMinhaVida_03junho2013.mdb
que executa o sorteio aleatório (evento do botão Sortear do formulário Sortear)
Private Sub bot01_Click()
'define variáveis
Dim QtJaSorteado,
QtDeNomes, InscricaoObtida, QuantJaSorteado, BuscaInscricao
Dim QualLoteamento,
falta01, falta02, QtPassou, QtDeInscritos
'conta quantos sorteios já
foram realizados
QtJaSorteado
= DCount("Ordem", "Sorteados")
'conta quantos candidatos ao
sorteio existem no cadastro
QtDeInscritos
= DCount("Inscricao", "Nomes")
'verifica número de
inscrição, se começa em 1 e se há falhas na numeração
If QtDeInscritos
<> DMax("Inscricao", "Nomes") Then
MsgBox ("ATENÇÃO: " & Chr$(10) & "O
primeiro número de inscrição precisa começar em 1 e não pode ter falhas na
numeração." & Chr$(10) & "Esse tipo de erro impede o
sorteio.")
Exit Sub
End If
'se QtJaSorteado for maior
do que 0 indicará que o sorteio foi interrompido (queda de energia, defeito no
computador...)
‘você pode simular essa
situação utilizando CRTL+ALT+DEL para fechar o arquivo. Ao abrir exibirá o
último sorteado
If QtJaSorteado
> 0 Then
If MsgBox("Deseja continuar o sorteio que já teve "
& QtJaSorteado & " agora?", vbYesNo) = vbNo Then
'sai
do procedimento sem continuar o sorteio
Exit
Sub
End If
Else
If MsgBox("Deseja executar o sorteio agora?",
vbYesNo) = vbNo Then
'sai
do procedimento sem executar o sorteio
Exit
Sub
End If
End If
'se QtDeInscritos for menor
do que a quantidade de imóveis não executa o sorteio
'não justifica fazer o
sorteio se há menos imóveis que candidatos
If Abs(QtDeInscritos)
< Abs(Me.TSort) Then
MsgBox ("Há mais imóveis (" & Me.TSort &
") do que candidatos inscritos (" & QtDeInscritos & ")."
& Chr$(10) & Chr$(10) & "Para realizar o sorteio é preciso que
os inscritos sejam em quantidade igual ou superior ao de imóveis.")
'sai do
procedimento sem executar o sorteio
Exit Sub
End If
'Muda foco para a lista de sorteados
Me.Lista01.SetFocus
'Inicia um loop até obter a quantidade de inscrições
definida no campo 'Total de Imóveis'
Do
'Identifica quantas inscrições já
foram sorteadas
QuantJaSorteado = DCount("Ordem",
"Sorteados")
'Encerra se a quantidade já sorteada
for igual a quantidade do campo 'Total de Imóveis'
If Abs(QuantJaSorteado) = Abs(Me.TSort) Then
Exit
Do
End If
'Executa a instrução Randomize para
tornar aleatórios os números obtidos nos sorteios
‘Essa
instrução será executada 456 vezes (1 para cada casa
sorteada)
Randomize
'Executa loop
aninhado até achar uma inscrição que ainda não foi sorteada
Do
'Executa cálculo
aleatório e atribui à variável InscricaoObtida
InscricaoObtida = Int((QtDeInscritos + 1) * Rnd)
'Sai do loop aninhado
ao encontrar matrícula ainda não sorteada
If
IsNull(DLookup("InscricaoSorteada",
"Sorteados", "InscricaoSorteada=" & InscricaoObtida))
Then Exit Do
Loop
'Identifica de qual loteamento fará
parte o sorteio atual (InscricaoObtida)
'Muda a cor do loteamento que estiver
sendo sorteado para amarelo
If QuantJaSorteado < Me.nbyQtImoveis Then
QualLoteamento = Me.txtLoteamento01
Me.falta01.BackColor = 10092543
Me.falta02.BackColor = 16777164
Me.nbyQtImoveis.BackColor = 10092543
Me.nbyQtImoveis02.BackColor = 16777164
Me.txtLoteamento01.BackColor = 10092543
Me.txtLoteamento02.BackColor = 16777164
Else
QualLoteamento = Me.txtLoteamento02
Me.falta02.BackColor = 10092543
Me.falta01.BackColor = 16777164
Me.nbyQtImoveis02.BackColor
= 10092543
Me.nbyQtImoveis.BackColor = 16777164
Me.txtLoteamento02.BackColor = 10092543
Me.txtLoteamento01.BackColor = 16777164
End If
'Localiza a matrícula e o nome do sorteado
na consulta que identifica homônimos
Me.SorteadoAtual = DLookup("NomeHomonimo",
"ListaHomonimos_02", "Inscricao=" & InscricaoObtida)
'Oculta mensagem padrão de inclusão e
faz a inclusão de 1 registro na tabela 'Sorteados'
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO Sorteados (InscricaoSorteada,
QualLoteamento ) SELECT " & InscricaoObtida & ",'" &
QualLoteamento & "';"
DoCmd.SetWarnings True
'Identifica quantas inscrições já
foram sorteadas
QuantJaSorteado = DCount("Ordem",
"Sorteados")
'Identifica a quantidade de inscrições
que faltam para sortear
If QuantJaSorteado > Me.nbyQtImoveis Then
QtPassou = QuantJaSorteado - Me.nbyQtImoveis
Else
QtPassou = 0
End If
If QtPassou = 0 Then
Me.falta01
= Me.nbyQtImoveis - QuantJaSorteado
Me.falta02
= Me.nbyQtImoveis02
Else
Me.falta01
= 0
Me.falta02
= (Me.nbyQtImoveis + Me.nbyQtImoveis02) -
QuantJaSorteado
End If
Me.Lista01.Requery
‘exibe número do sorteado e fica aguardando operador
pressionar OK para continuar
MsgBox "Inscrição
Sorteada:" & Chr$(9) & InscricaoObtida, , "Sorteio"
'sai do loop
quanto atingir o total dos dois loteamentos
If Abs(QuantJaSorteado) = Abs(Me.TSort) Then Exit Do
Loop
'Retorna a cor dos campos e exibe mensagem de encerramento
Me.falta02.BackColor
= 16777164
Me.falta01.BackColor
= 16777164
Me.nbyQtImoveis02.BackColor
= 16777164
Me.nbyQtImoveis.BackColor
= 16777164
Me.txtLoteamento02.BackColor
= 16777164
Me.txtLoteamento01.BackColor
= 16777164
MsgBox
"Concluído processo de sorteio!" & Chr$(10) & Chr$(10) &
"Feche o formulário para imprimir os relatórios."
End Sub
Dica:
Comentário: não há nenhum tipo de proteção no arquivo.
Mensagens do Microsoft Access de versões superiores a 2000 podem ser exibidas
dependendo do nível de segurança de macro e código estabelecidos em seu
computador.
Importante:
Comentário: a instrução Randomize
é chamada antes de cada sorteio (456 casas = 456 chamadas) e o intervalo entre
um sorteio e outro é ditado pelo ritmo da leitura dos nomes o que torna mais
aleatório o processo.
|
Inicializa o gerador de
números aleatórios. Sintaxe Randomize [number] O argumento opcional number
é uma Variant ou qualquer expressão numérica válida. Comentários Randomize utiliza number para inicializar o gerador de
números aleatórios da função Rnd, dando-lhe um novo valor de semente
(um valor inicial utilizado para gerar números pseudo-aleatórios). Por
exemplo, a instrução Randomize
cria um número semente. Se você
omitir number, o valor retornado pelo cronômetro do sistema será
utilizado como o novo valor de semente. Se Randomize não for
utilizado, a função Rnd (sem argumentos) utilizará o mesmo número como
uma semente a primeira vez é chamada, e daí em diante utilizará o último
número gerado como valor semente. Observação |
|
Exemplo da instrução Randomize Este exemplo utiliza a
instrução Randomize para inicializar o gerador de números aleatórios. Como o
argumento de número foi omitido, Randomize utiliza o valor de retorno da
função Timer como o novo valor semente. Dim MyValue
Randomize ' Inicializa o gerador de números
aleatórios. MyValue = Int((6 * Rnd) + 1) ' Gera um valor aleatório entre 1 e 6. |
|
Texto retirado da ajuda do Microsoft Access 2003 |