조금 오래전에 만든 추첨기의 코드입니다. 프로젝트 폴더를 정리하다가 추첨기 프로젝트가 있길래 올렸습니다.


추첨기.zip


Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Sub ReleaseCapture Lib "user32" ()

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Sub Command5_Click()
List1.Clear
End Sub

Private Sub Command6_Click()
List2.Clear
End Sub

Private Sub Command7_Click()
Dim Tmp As String
    CommonDialog1.Filter = "텍스트문서(*.txt)|*.txt"
    CommonDialog1.ShowOpen
        
    If CommonDialog1.FileName <> "" Then
    
    List1.Clear
    
    Open CommonDialog1.FileName For Input As #1
        Do While Not EOF(1)
            Line Input #1, Tmp
            List1.AddItem Tmp
        Loop
    Close #1
    End If
End Sub

Private Sub Label8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Dim lngReturnValue As Long

 If Button = 1 Then
  Call ReleaseCapture
  lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
 End If
End Sub
Private Sub Command1_Click()
Dim i As Integer
If Text1 = "" Then
    MsgBox "리스트에 공백이 올수 없습니다.", vbExclamation, "경고"
Else
    If Option1.Value = False Then
    List1.AddItem Text1
    Text1 = ""
    Text1.SetFocus
    Else
    For i = 0 To List1.ListCount
    If List1.List(i) = Text1.Text Then
    List1.RemoveItem i
    End If
    Next i
    List1.AddItem Text1
    Text1 = ""
    Text1.SetFocus
    End If
End If
End Sub
Private Sub Command2_Click()
If List1.ListIndex = -1 Then
    MsgBox "리스트를 선택하여 주세요!", vbCritical, "알림"
Else
    List1.RemoveItem List1.ListIndex
End If
End Sub
Private Sub Command3_Click()
Dim j As Integer
If Text4 > 1000 Then MsgBox "반복 횟수는 1000번을 넘을 수 없습니다.", vbCritical, "에러": Exit Sub

If Text2 = "0" Or Text2 = "" Then
    MsgBox "당첨자 수를 입력해주세요.", vbCritical, "알림"
Else
    If Text2 > List1.ListCount Then
       MsgBox "당첨자 수가 리스트의 수보다 더 많습니다.", vbCritical, "에러"
    Else
    For j = 1 To Int(Text4.Text)
        Random_List
    Next j
    End If
End If
End Sub
Private Sub Command4_Click()
If Text3.Text = "" Then
MsgBox "파일 이름을 입력해주세요.", vbCritical, "에러"
Text3.SetFocus
Exit Sub
End If
If List2.ListCount = 0 Then
MsgBox "당첨 리스트가 존재하지 않습니다.", vbCritical, "에러"
Exit Sub
End If
Dim FF As Integer, i As Integer, Temp As String
FF = FreeFile

For i = 0 To List2.ListCount - 1
    Temp = Temp & List2.List(i) & vbCrLf
Next i

Temp = Mid(Temp, 1, Len(Temp) - 1)
    
Open App.Path & "\" & Text3.Text & ".txt" For Output As #FF
     Print #FF, Temp
Close #FF
MsgBox "파일이 성공적으로 추출되었습니다!", vbInformation, "파일 추출"
End Sub
Private Sub Form_Load()
Option2.Value = True
Text3.Text = "추첨기"
Text4.Text = 1
End Sub
Private Sub Label6_Click()
Form1.WindowState = 1
End Sub

Private Sub Label7_Click()
Unload Me
End Sub

Private Sub Option1_Click()
Option2.Value = False
End Sub
Private Sub Option2_Click()
Option1.Value = False
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Call Command1_Click
End Sub
Private Sub Text2_Change()
Text2 = Val(Text2)
Text2.SelStart = Len(Text2)
End Sub
Private Sub Text4_Change()
Text4 = Val(Text4)
Text4.SelStart = Len(Text4)
End Sub
Private Sub Random_List()
Dim Temp() As String, i As Integer, j As Integer, k As Integer

ReDim Temp(List1.ListCount - 1)

For i = 0 To List1.ListCount - 1
    Temp(i) = List1.List(i)
Next i

List2.Clear
For i = 1 To Text2
    j = Int(Rnd * (List1.ListCount))
    List2.AddItem List1.List(j)
    ' --
    If Option1.Value Then List1.RemoveItem j
Next i

List1.Clear

For i = 0 To UBound(Temp)
    List1.AddItem Temp(i)
Next i
End Sub