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,590
Được thích
16,653
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
Sự phụ Hoàng Trọng Nghĩa cho em xin mật khẩu để tạo thêm sheet được không! em cần nhiều sheet trong 1 file anh giúp em với...
số điện thoại 0902363793. hoặc anh gửi mật khẩu mail cho em với thinhdinh89@gmail.com thanks anh nhiều.
em đang xem file Quay_So_GPE_New2..
Bài đã được tự động gộp:

Sự phụ Hoàng Trọng Nghĩa cho em xin mật khẩu để tạo thêm sheet được không! em cần nhiều sheet trong 1 file anh giúp em với...
số điện thoại 0902363793. hoặc anh gửi mật khẩu mail cho em với thinhdinh89@gmail.com Cảm ơn anh nhiều.
em đang xem file Quay_So_GPE_New2..
anh chỉ cho em chọn cbox tỉnh thành thành tên khác được không. em bị kẹt thêm cái cbox tỉnh thành muốn chuyển thành tên từng bộ phận cho nhóm em ấy mà
 
Upvote 0
Sự phụ Hoàng Trọng Nghĩa cho em xin mật khẩu để tạo thêm sheet được không! em cần nhiều sheet trong 1 file anh giúp em với...
số điện thoại 0902363793. hoặc anh gửi mật khẩu mail cho em với thinhdinh89@gmail.com Cảm ơn anh nhiều.
em đang xem file Quay_So_GPE_New2..
Bài đã được tự động gộp:


anh chỉ cho em chọn cbox tỉnh thành thành tên khác được không. em bị kẹt thêm cái cbox tỉnh thành muốn chuyển thành tên từng bộ phận cho nhóm em ấy mà
Bạn nhắn tin riêng đi nhé, cứ xin cho thì không hay. Mà chán thật, đã tặng mà lại còn pass với piếc. Ai lấy về phá hư tự chịu đi
 
Upvote 0
Upvote 0
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/...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!
Anh Nghĩa đẹp trai có file 64 bit không anh. Máy em 64 bit không xem được gì hết, hi.
 
Upvote 0
Web KT
Back
Top Bottom