경품 추첨

https://cafe.naver.com/excelmaster/165990 에 올라온 질문입니다.

경춤 추첨 프로그램 만드는데요..

사다리나 명단 추첨을 하려는데 버튼을 누르자마자 명단이 짠 하고 나타나니

긴장감이 전혀 없습니다. 추첨은 쪼는 맛이 있어야하는데요.

 

그래서 슬롯머신 효과를 주어 이름이 나타나게 했습니다.

주로 방송에서 득표수같은 걸 나타낼 때 많이 쓰입니다.

 

Option Explicit
Private tmp() As String
Private v As Variant
 
Private Sub CommandButton1_Click()
 
    Dim cnt1 As Integer, cnt2 As Integer, cnt3 As Integer
    Dim AbortTime As Date
    Dim time1 As Date
    Dim time2 As Date
    Dim MyChamp As String
    
    Randomize
 
    MyChamp = v(Int(Rnd * UBound(v)), 1)    '당첨자
 
    '지연할 시간
    AbortTime = Now + TimeValue("00:00:03")
    time1 = AbortTime + TimeValue("00:00:01")
    time2 = AbortTime + TimeValue("00:00:02")
    
    '이름 섞기
    Do Until Now > AbortTime
        DoEvents
        Label1.Caption = tmp(Int(Rnd * UBound(tmp)))
        Label2.Caption = tmp(Int(Rnd * UBound(tmp)))
        Label3.Caption = tmp(Int(Rnd * UBound(tmp)))
    Loop
    
    Label3.Caption = Mid(MyChamp, 3, 1)
    
    Do Until Now > time1
        DoEvents
        Label1.Caption = tmp(Int(Rnd * UBound(tmp)))
        Label2.Caption = tmp(Int(Rnd * UBound(tmp)))
    Loop
    
    Label2.Caption = Mid(MyChamp, 2, 1)
    
    Do Until Now > time2
        DoEvents
        Label1.Caption = tmp(Int(Rnd * UBound(tmp)))
    Loop
    
    Label1.Caption = Mid(MyChamp, 1, 1)
 
End Sub
 
Private Sub UserForm_Initialize()
 
    Dim i As Integer
    Dim miniI As Integer
    Dim j As Integer
    
    CommandButton1.Enabled = False
    
    '이름을 분해하여 배열에 삽입
    v = Range("A1").CurrentRegion
    
    For i = 1 To UBound(v, 1)
        For miniI = 1 To Len(v(i, 1))
            ReDim Preserve tmp(j)
            tmp(j) = Mid(v(i, 1), miniI, 1)
            j = j + 1
        Next
    Next
    
    CommandButton1.Enabled = True
 
End Sub
 

통합 문서1 (1).xlsm

0.02MB