Tặng các bạn file "QUAY SỐ TRÚNG THƯỞNG" nhân dịp SN GiaiphapExcel.Com lần 5

Liên hệ QC

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,610
Được thích
16,671
Giới tính
Nam
Ngày 2/7/2011 vừa qua thật vui nhộn, hạnh phúc, đoàn kết, thân mật. Một trong những niềm vui đó là phần quay số trúng thưởng, những phần quà nhỏ có, to có, dài có, ngắn có, nặng có, nhẹ có... được các bạn lần lượt chọn lựa sau khi trúng thưởng, và thật ngạc nhiên đầy thú vị khi mở quà: bưởi, cam, mướp, ớt v.v... điều đó đã làm tạo niềm vui bất ngờ cho các thành viên.

Qua đó, tôi thấy một số thành viên rất thích chương trình này, vì vậy, hôm nay tôi tặng các bạn file "QUAY SỐ TRÚNG THƯỞNG", tuy không phải là phần mềm gì, nhưng cũng tạo được niềm vui cho các bạn. Nhiều người vẫn nghĩ rằng Excel chỉ là những bảng tính với những hàm, công thức khô khan, thì hôm nay có thể các bạn sẽ nghĩ khác về nó!

Chương trình này được thiết kế và phát triển dựa trên File "Rút thăm trúng thưởng" của Thầy AnhTuan1066. Tôi xin cảm ơn Thầy đã sáng tác chương trình này. (Nguồn: http://www.giaiphapexcel.com/forum/showthread.php?24123-Tạo-hiệu-ứng-cho-UserForm&p=167689#post167689)

Một số hình ảnh giao diện:

attachment.php




attachment.php


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

PHP:
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

PHP:
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

PHP:
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

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é!
Link tải thư mục Media: http://www.4shared.com/file/e8eOz7BS/Media.html

attachment.php


Nếu không tải Thư mục Media về cũng không có sao, chương trình vẫn chạy mà không có phát nhạc thôi các bạn.

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!
 

File đính kèm

  • QuaySo1.jpg
    QuaySo1.jpg
    19 KB · Đọc: 2,001
  • QuaySo2.jpg
    QuaySo2.jpg
    18 KB · Đọc: 1,897
  • HD.jpg
    HD.jpg
    13 KB · Đọc: 1,909
  • Quay_So_GPE.rar
    100 KB · Đọc: 4,031
minhthien cho hỏi mấy số này có ý nghĩa gì vậy

untitled.JPG
 
Upvote 0
Cột đầu tiên là số thứ tự tính từ lần quay đầu tiên đến n số nhập vào. Cột thứ 2 là số phiếu may mắn của người được trúng thưởng ạ.
Có thể cải tiến cho thêm phần sống động:
- Nhập vào danh sách quà tặng hiện có
- Quay số và xuất kết quả theo những quà tặng này
-----------
Vì thông thường thì SỐ LƯỢNG QUÀ TẶNG quyết định kết quả chứ không phải số lượng người tham gia quyết định (tức có bao nhiêu quà, quay bấy nhiêu)
 
Upvote 0
Có thể cải tiến cho thêm phần sống động:
- Nhập vào danh sách quà tặng hiện có
- Quay số và xuất kết quả theo những quà tặng này
-----------
Vì thông thường thì SỐ LƯỢNG QUÀ TẶNG quyết định kết quả chứ không phải số lượng người tham gia quyết định (tức có bao nhiêu quà, quay bấy nhiêu)

Em nghĩ có thể làm được, tuy nhiên, quà thì để trong gói, khi mở ra mới thấy bất ngờ chứ ạ?
 
Upvote 0
Em nghĩ có thể làm được, tuy nhiên, quà thì để trong gói, khi mở ra mới thấy bất ngờ chứ ạ?

Mình có thể kết hợp luôn, tiết kiệm , khỏi gói quà, bỏ trong thùng, ko ai thấy, bấm cái trúng 1 món quà ngẫu nhiên cung tạo sự bất ngờ..............
 
Upvote 0
Mình có thể kết hợp luôn, tiết kiệm , khỏi gói quà, bỏ trong thùng, ko ai thấy, bấm cái trúng 1 món quà ngẫu nhiên cung tạo sự bất ngờ..............

Cũng có một chút khó khăn khi làm vấn đề này, nếu người giữ số phiếu mà không có mặt ở đó, mình hủy phiếu thì khả năng sẽ xóa luôn phần quà (chưa chắc chắn, nhưng đang lường trước vấn đề).
 
Upvote 0
Em nghĩ có thể làm được, tuy nhiên, quà thì để trong gói, khi mở ra mới thấy bất ngờ chứ ạ?
Ý ndu là cải tiến để giới hạn số lần quay:
- Số phiếu phát ra = 100
- Số quà =5
- Số lần quay = 5
- nếu quay ra 1 số mà người cầm số đó đã ra về, quay lại, thì điều chỉnh biến đếm.

Ngoài ra: Không phải là mở gói quà ra.
Chính là đánh số gói quà là 1, 2, ...
Lần quay thứ nhất: gói quà 01
...

Nghĩa là cải tiến cái giao diện 2 cột bên trên.
 
Upvote 0
Em nghĩ có thể làm được, tuy nhiên, quà thì để trong gói, khi mở ra mới thấy bất ngờ chứ ạ?
Tôi nêu ý tưởng này là vì ở cty tôi, vào dịp tết cũng hay rút thăm trúng thưởng dựa vào những tặng phẩm hiện có
Ví dụ:
- Rút thăm đợt 1 là TV. đợt 2 là xe đạp... chẳng hạn
- Số người tham gia không giới hạn nhưng số lần quay là giới hạn (dựa vào số tặng phẩm)
- Số của ai trúng vào đợt nào thì lấy tặng phẩm của đợt ấy
vân vân...
-------------
Đương nhiên, có nhiều hình thức rút thăm khác nhau, có thể tùy biến thoải mái
 
Upvote 0
Cũng có một chút khó khăn khi làm vấn đề này, nếu người giữ số phiếu mà không có mặt ở đó, mình hủy phiếu thì khả năng sẽ xóa luôn phần quà (chưa chắc chắn, nhưng đang lường trước vấn đề).

Vậy bấm 2 lần được ko anh? 1 lần chọn người may mắn, 1 lần chọn quà ngẫu nhiện?
 
Upvote 0
Tôi nêu ý tưởng này là vì ở cty tôi, vào dịp tết cũng hay rút thăm trúng thưởng dựa vào những tặng phẩm hiện có
Ví dụ:
- Rút thăm đợt 1 là TV. đợt 2 là xe đạp... chẳng hạn
- Số người tham gia không giới hạn nhưng số lần quay là giới hạn (dựa vào số tặng phẩm)
- Số của ai trúng vào đợt nào thì lấy tặng phẩm của đợt ấy
vân vân...
-------------
Đương nhiên, có nhiều hình thức rút thăm khác nhau, có thể tùy biến thoải mái

Các phần thưởng của Thầy vĩ đại quá, chắc phải làm một cái Menu Form rồi mới tính tiếp Quay Số quá!
 
Upvote 0
Bạn nhập mọi thứ vào sheet là được rồi (lấy sheet làm nơi lưu trử)

Case:

Quay lần 1: Giải thưởng 1 TV: phiếu x
Quay lần 2: Giải thưởng 1 xe đạp: phiếu y
Quay lần 3: Giải thưởng 1 chiếc cặp: phiếu z
...

Phiếu y không có mặt, hủy, trường hợp này tính sao? Đôn giải lên hay sao???
 
Upvote 0
Bàitrên đã nói rồi không chịu đọc:
Ý ndu là cải tiến để giới hạn số lần quay:
- Số phiếu phát ra = 100
- Số quà =5
- Số lần quay = 5
- nếu quay ra 1 số mà người cầm số đó đã ra về, quay lại, thì điều chỉnh biến đếm.
Đánh số gói quà là 01, 02, ...
Lần quay thứ nhất: gói quà 01

Hoặc là không tăng biến đếm:
Tạo 1 biến đếm Solan (ban đầu =0)
Số quà = 5, số lần quay quy ước = 5.
- Quay lần 1, gói quà 01, ra số x: x có mặt, nhấn 1 nút, biến đếm Solan tăng 1 -> 1
- Quay lần 2, gói quà 02, ra số y: y không có mặt, nhấn 1 nút khác, biến đếm Solan không tăng
- Quay lại lần 2, vẫn giải 02, ra số z: z có mặt, biến đếm Solan tăng 1 -> 2
- Quay lần 3, gói quà 03, ...
- ....
- Biến đếm Solan = 5: thông báo hết quà, chấm dứt quay.
 
Upvote 0
Bàitrên đã nói rồi không chịu đọc:


Hoặc là không tăng biến đếm:
Tạo 1 biến đếm Solan (ban đầu =0)
Số quà = 5, số lần quay quy ước = 5.
- Quay lần 1, gói quà 01, ra số x: x có mặt, nhấn 1 nút, biến đếm Solan tăng 1 -> 1
- Quay lần 2, gói quà 02, ra số y: y không có mặt, nhấn 1 nút khác, biến đếm Solan không tăng
- Quay lại lần 2, vẫn giải 02, ra số z: z có mặt, biến đếm Solan tăng 1 -> 2
- Quay lần 3, gói quà 03, ...
- ....
- Biến đếm Solan = 5: thông báo hết quà, chấm dứt quay.

Vậy cần gì làm xa vời vậy Thầy? nếu vậy thì căn cứ số thứ tự mà làm thôi! Lần quay 1, số thứ tự 1, món quà 1. Vậy chỉnh làm gì chứ! Còn quay nữa hay không là do người quay quyết định thôi!
 
Upvote 0
Vậy cần gì làm xa vời vậy Thầy? nếu vậy thì căn cứ số thứ tự mà làm thôi! Lần quay 1, số thứ tự 1, món quà 1. Vậy chỉnh làm gì chứ!

Hỏi gì trả lời nấy, bây giờ trả lời xong lại chê?

Nếu quay lần 2, món quà 2 (có thể là "xe đạp"), ra số y, mà y vắng mặt, thì "xe đạp" biến mất? (Nội dung câu hỏi là vậy đấy)
Còn quay nữa hay không là do người quay quyết định thôi!
Không đếm được những cái "quyết định" thì có được cái thông báo hết quà không?
 
Lần chỉnh sửa cuối:
Upvote 0
Hỏi gì trả lời nấy, bây giờ trả lời xong lại chê?

Nếu quay lần 2, món quà 2 (có thể là "xe đạp"), ra số y, mà y vắng mặt, thì "xe đạp" biến mất? (Nội dung câu hỏi là vậy đấy)

Dạ, chính vì vậy em mới "théc méc" cái vụ có đôn lên không hay vẫn giữ nguyên giá trị giải thưởng của người thứ 3 trong trường hợp này đó mà!

Vì,
Người A giải 1, người B giải 2, người C giải 3

Nếu người B bỏ cuộc, hủy, thì người C vẫn là giải 3 hay đôn lên thành giải 2 đó mà.
 
Upvote 0
Tại đặt vấn đề ngược.
Người C được giải 2 hay giải 3, là quyết định trước khi quay, chứ không phải sau khi quay.

Vấn đề là giải 2 chưa giao (vì B vắng mặt), vậy có muốn trao người khác hay không. Muốn trao người khác thì quay tiếp cho 02, nếu muốn cất làm của, thì "đôn lên", quay cho gói quà 03.

Nếu làm theo hướng của bài trả lời, thì muốn gì được nấy: nhấn nút này thì tăng biến đếm, qua món quà khác, nhấn nút kia thì không tăng biến đếm, quay lại số 02.

Note:
Nói ngắn gọn là vậy, nhưng nhấn nút này hay nút kia sẽ làm đồng thời nhiều việc:
- Tăng hoặc không tăng biến đếm
- Để lại tên món quà 2 trên màn hình để quay số khác, hay dời lên vùng kết quả
- Nếu dời lên vùng kết quả, thì xoá số vừa quay ra để khỏi quay ra kết quả cũ
- Nếu dời lên vùng kết quả, thì "đôn lên"
- ...
 
Upvote 0
Tặng các bạn file "QUAY SỐ TRÚNG THƯỞNG" nhân dịp SN GiaiphapExcel.Com lần 6

Sinh nhật lần thứ 5 tôi đã thiết kế chương trình với các lần rút thăm là SỐ, với sinh nhật lần này, tôi đã thiết kế lại và cập nhật theo SỐ THỨ TỰ và NICKNAME kèm theo.

Hy vọng chương trình mới này giúp các bạn vui.

attachment.php


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

Mã:
Private Sub cmdQuaySo_Click()
    Dim Lucky As String, HoTen As String, n As Long
    Dim CC As String, m As String
    
    GameOver = False
    
    If cmdQuaySo.Caption = lblQS.Caption Then
        cmdQuaySo.Caption = lblDL.Caption
        cmdQuaySo.BackColor = MauDo
        cmdReSet.BackColor = MauDo
        cmdReSet.Locked = True
        n = UBound(sArray)
        
        Select Case n
            Case Is < 10:  m = "0"
            Case Is < 100: m = "00"
            Case Else:     m = "000"
        End Select
        
        If k = 0 Then DictCount = n
        
        If DictCount = 0 Then
            MyUniMsgBox MsgEnd.Caption, vbCritical, 2, "Thông báo"
            cmdQuaySo.Enabled = False
            GoTo EndSub
        End If
        
        If Dict.Count = 0 Then
            For i = 1 To DictCount
                Dict.Add i, CStr(sArray(i, 1))
            Next
        End If
        'mciExecute ("play C:\WINDOWS\Media\flourish.mid")
        Do
            Randomize
            iRnd = Int((Dict.Count) * Rnd()) + 1
            Lucky = Dict.Item(iRnd)
            For j = 1 To n
                If sArray(j, 1) = Lucky Then Exit For
            Next
            txtNguon.Text = j
            lblSoPhieu.Caption = Format(j, m)
            lblNickName.Caption = Lucky
            HoTen = IIf(sArray(j, 2) = "", lblChuaTen.Caption, sArray(j, 2))
            Sleep 1
            DoEvents
            If cmdQuaySo.Caption = lblQS.Caption Or GameOver Then GoTo Ends
        Loop
        
Ends:
        
        If GameOver Then Exit Sub
        
        With lbxKetQua
            .AddItem .ListCount + 1
            j = .ListCount
            .List(j - 1, 1) = lblSoPhieu.Caption
            .List(j - 1, 2) = lblNickName.Caption
            .List(j - 1, 3) = HoTen
            .ListIndex = j - 1
        End With
        
        k = k + 1
        DictCount = DictCount - 1
        Dict.Remove iRnd
        
        Call CapNhatDict
    Else
EndSub:
        cmdQuaySo.Caption = lblQS.Caption
        cmdQuaySo.BackColor = MauXanhNhat
        cmdReSet.BackColor = MauXanhNhat
        cmdReSet.Locked = False
        'mciExecute ("stop C:\WINDOWS\Media\flourish.mid")
        'mciExecute ("play C:\WINDOWS\Media\kaka.Wav")
    End If

End Sub

Với cải tiến này, làm thêm phần địa danh nơi thực hiện quay số, đồng thời, tôi thêm 4 danh sách trên 4 sheet để có nhiều lựa chọn, tôi nghĩ các bạn sẽ dễ dàng nhập vào danh sách các bạn muốn quay số!
 

File đính kèm

  • Picture1.jpg
    Picture1.jpg
    98.2 KB · Đọc: 977
  • Quay_So_GPE_New2.rar
    207.9 KB · Đọc: 1,007
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom