Sunday, April 14, 2019

Tặng các bạn file "QUAY SỐ TRÚNG THƯỞNG"

Link tải thư mục : Tại đây

HƯỚNG DẪN SỬ DỤNG:

Đây là File Excel có sử dụng Macro vì vậy, khi tải file về, tại mục Macro Security... các bạn nhớ phải cài ở chế độ LOW (hoặc MEDIUM) trước khi sử dụng nhé!

File này có sử dụng các bài nhạc, vì vậy, nếu các bạn nào muốn "ồn ào" một tí thì tải luôn cái file "Media" tại đường dẫn dưới đây về, sau đó các bạn giải nén và để thư mục Media này chung với thư mục chứa file "Quay_So_GPE" này nhé!

QuaySo1

Link tải thư mục : Tại đây


QuaySo2

HD

.com/proxy/

Các bạn nhập số (chương trình cho phép nhập tối đa 999 số, các bạn có thể tùy chỉnh trong code) và QUAY SỐ thôi. Click vào nút DỪNG LẠI để chọn số may mắn. Các bạn có thể thao tác toàn bộ bằng phím ENTER hoặc phím SPACEBAR để quay số và chọn số.

Khi số được chọn sẽ hiển thị trên LISTBOX, các bạn có thể xóa số đó nếu người may mắn không có mặt tại đó bằng cách double click vào ngay số đó.

Chúc các cảm nhận được sự thú vị vui vẻ với chương trình này!

Link tải thư mục : Tại đây

Các câu lệnh chính trong VBA:

Private Sub NhapPhieu_1_Click()
  Set DicItem1 = CreateObject("Scripting.Dictionary")
  DictCount = 0: k = 0
  LbTieuDe.Visible = False
  LbNTT.Visible = False
  SoPhieu_1.Visible = False
  LbNMM.Caption = LbNMM.Caption & " / " & SoPhieu_1
  LbHD.Visible = False
  NhapPhieu_1.Visible = False
  LbNMM.Visible = True
  STT_1.Visible = True
  With Start_1
    .Caption = QS.Caption: .BackColor = 49152
    .Enabled = True: .Visible = True: .SetFocus
  End With
  CmdReSet_1.Visible = True
  Call PlayMusic
  MS = 2
End Sub

Private Sub Start_1_Click()
  With Start_1
    Call StopYeah
    CC = .Caption
    CmdReSet_1.Visible = False
    If CC = BD.Caption Or CC = QS.Caption Then
      .Caption = DL.Caption: .BackColor = 255
      If k = 0 Then DictCount = Val(SoPhieu_1)
      If DictCount = 0 Then UniMsgBox MsgEnd.Caption, vbCritical, "Thông báo": _
      CmdReSet_1.Visible = True: .Enabled = False: Call StopMusic: Exit Sub
      Call PlayMusic
      Solan = Val(Solan) + 1
      LbNMM.Caption = NMM.Caption & WorksheetFunction.Max(Solan, 1) & " / " & SoPhieu_1
      If DicItem1.Count = 0 Then
        For i = 1 To DictCount
          DicItem1.Add i, i
        Next
      End If
      Do
        Randomize
        iRnd = Int((DicItem1.Count) * Rnd()) + 1
        Nguon = DicItem1.Item(iRnd)
        Sleep 1
        DoEvents
        CC = Start_1.Caption
        If CC = QS.Caption Or GameOver = True Then GoTo Ends
      Loop
Ends:
      If GameOver = True Then Exit Sub
      With ListBox1
        .AddItem .ListCount + 1
        .List(.ListCount - 1, 1) = DicItem1.Item(iRnd)
        .ListIndex = .ListCount - 1
        .Visible = True
      End With
      k = k + 1: DictCount = DictCount - 1
      DicItem1.Remove iRnd
      Call CapNhatDict
      Call PlayYeah
    ElseIf CC = DL.Caption Then
      Call PlayMusic
      .Caption = QS.Caption: .BackColor = 49152
      MS = Val(MS) + 1: MS = IIf(MS > 9, 2, MS)
      CmdReSet_1.Visible = True
      LbNMM.ForeColor = 255
    End If
  End With
End Sub

Private Sub CapNhatDict()
  DicItem2 = Join(DicItem1.Items, " "): DicItem2 = Split(DicItem2, " ")
  Set DicItem1 = CreateObject("Scripting.Dictionary")
  For i = 0 To UBound(DicItem2)
    DicItem1.Add i + 1, DicItem2(i)
  Next
End Sub


Link tải thư mục : Tại đây

No comments:

Post a Comment

Over 50 Ebooks Excel and VBA free Download

1. Statistics and Probability for Engineering Applications With Microsoft Excel by W.J. DeCoursey - PDF Free Download Download Siz...