Tặng các bạn file "QUAY SỐ TRÚNG THƯỞNG" nhân dịp Tết cổ truyền. (1 người xem)

Hoàng Trọng Nghĩa · 23/1/14

Nhân dịp Tết cổ truyền, có thể là tất niên và cũng có thể là tân niên, một số cty tổ chức rút thăm trúng thưởng, nếu như có một chương trình như thế này để vui chơi thì tạo thêm không khí tưng bừng cho ngày xuân phải không các bạn!

Không khác gì mấy với cách thức và giao diện của bài này:

http://www.giaiphapexcel.com/forum/...N-GiaiphapExcel-Com-lần-5&p=323317#post323317

Nhưng lần cải tiến này đã thay đổi bên trong rất nhiều, cụ thể là trước đó chỉ dùng 1 UserForm để thực hiện quay số nên nhiều công đoạn rối rắm, nay dùng tới 2 UserForm cho việc này, đồng thời cải tiến code và giao diện đẹp hơn, hiệu quả hơn.

Từ bài viết này:

Hoàng Trọng Nghĩa đã viết:
Bài này hay quá Thầy ơi, hôm nay em mới đọc được! Hay quá chỉ có chép về và nghiên cứu xem mình sẽ ứng dụng gì với hàm này đây!

SẼ NHANH CHÓNG CÓ MỘT ỨNG DỤNG XÀI CHO HÀM PictureFromObject NÀY!

http://www.giaiphapexcel.com/forum/...Sheet-lên-Button-của-Form&p=558617#post558617

tôi đã có cảm hứng và viết một ứng dụng dùng ngay cho hàm PictureFromObject nói trên, nó làm cho tôi khám phá nhiều hơn và tôi thật sự thích thú về điều đó.

Điểm nổi bật của chương trình lần này là người dùng không cần phải biết VBA cũng có thể đổi LOGO (hình ảnh) của công ty mình mà không phải Alt+F11 để đổi thủ công nữa! Chỉ cần bấm nút và thưởng thức!

Các bạn tải file về giải nén và trải nghiệm một ứng dụng từ hàm PictureFromObject của Thầy ndu96081631 nhé!

trung984 · 23/1/14

Hoàng Trọng Nhĩa chớp thời cơ nhanh lắm, cách Load hình ảnh được ứng dụng từ bài này.

http://www.giaiphapexcel.com/forum/showthread.php?74484-Load-Shape-của-Sheet-lên-Button-của-Form

File rất hay, nhưng cần bổ sung thêm code và quy định thời gian là bao nhiêu giây để cho nó dừng, để không phải bấm nút dừng lại.

Dù sao cũng cám ơn bạn đã có ứng dụng hay.

Hoàng Trọng Nghĩa · 24/1/14

trung984 đã viết:
Hoàng Trọng Nhĩa chớp thời cơ nhanh lắm, cách Load hình ảnh được ứng dụng từ bài này.

http://www.giaiphapexcel.com/forum/showthread.php?74484-Load-Shape-của-Sheet-lên-Button-của-Form

File rất hay, nhưng cần bổ sung thêm code và quy định thời gian là bao nhiêu giây để cho nó dừng, để không phải bấm nút dừng lại.

Dù sao cũng cám ơn bạn đã có ứng dụng hay.

Đã nói bao nhiêu lần về vấn đề này rồi bạn, để nó tự dừng lại thì Thầy ndu96081631 đã làm ở file đầu tiên lận đó, chứ không phải giờ bạn mới thắc mắc đâu. Lý do đơn giản tôi làm vậy là để mang tính chất khách quan, mời một vị đại biểu lên bấm Enter để cho nó dừng lại, chứ để nó tự dừng thì nhiều người lại nghĩ mình lập trình sẳn số người dừng.

trung984 · 24/1/14

Hoàng Trọng Nghĩa đã viết:
Đã nói bao nhiêu lần về vấn đề này rồi bạn, để nó tự dừng lại thì Thầy ndu96081631 đã làm ở file đầu tiên lận đó, chứ không phải giờ bạn mới thắc mắc đâu. Lý do đơn giản tôi làm vậy là để mang tính chất khách quan, mời một vị đại biểu lên bấm Enter để cho nó dừng lại, chứ để nó tự dừng thì nhiều người lại nghĩ mình lập trình sẳn số người dừng.

Đâu phải tất cả mọi bài đã viết thì mọi thành viên đều đọc hết (kể cả các Mod), họ chỉ đọc những bài có liên quan.

Bài bạn nêu tôi chưa đọc thì lấy gì mà biết bài viết đó nêu những vấn đề gì?

Ý của bạn muốn cho các vị Lãnh đạo hoặc đại biểu bấm thì OK. Tôi đã hiểu ý.

TB:
Nghe thiên hạ đồn là bạn vui vẽ, yêu đời, nhất là thích lai rai đúng không? Hôm nào làm một bửa, không sai không về. Còn khi nào gặp thì sẽ biết tớ là ai.

Đồng Nai đi dễ khó về,
Trai đến có vợ, gái về có con.

Vậy là bạn hiểu tớ ở đâu rồi nhé.

ndu96081631 · 24/1/14

Hoàng Trọng Nghĩa đã viết:
Lý do đơn giản tôi làm vậy là để mang tính chất khách quan, mời một vị đại biểu lên bấm Enter để cho nó dừng lại, chứ để nó tự dừng thì nhiều người lại nghĩ mình lập trình sẳn số người dừng.

Thế nếu ta bấm Enter để chương trình dừng lại thì không.. ăn gian được à? Bấm gì mặc chú, tôi cứ ra số... NDU được hôn?
Ẹc... Ẹc...

Hoàng Trọng Nghĩa · 24/1/14

ndu96081631 đã viết:
Thế nếu ta bấm Enter để chương trình dừng lại thì không.. ăn gian được à? Bấm gì mặc chú, tôi cứ ra số... NDU được hôn?
Ẹc... Ẹc...

Được chứ Thầy iu! Có điều mình tạo cảm giác í mà! Đã gian rồi thì cỡ nào cũng gian được à! hehehehe.

ndu96081631 · 24/1/14

Hoàng Trọng Nghĩa đã viết:
Được chứ Thầy iu! Có điều mình tạo cảm giác í mà! Đã gian rồi thì cỡ nào cũng gian được à! hehehehe.

Nói vậy rồi.. ai dám xài đây (hổng tin)
Vậy suy nghĩ xem có cách nào chống.. ăn gian không?

Hoàng Trọng Nghĩa · 24/1/14

ndu96081631 đã viết:
Nói vậy rồi.. ai dám xài đây (hổng tin)
Vậy suy nghĩ xem có cách nào chống.. ăn gian không?

Bó tay, ăn gian thì dễ, chống ăn gian sao được Thầy ơi!

tungnguyen_kt · 24/1/14

Hoàng Trọng Nghĩa đã viết:
Bó tay, ăn gian thì dễ, chống ăn gian sao được Thầy ơi!

Chống ăn gian là không dùng cái có thể ăn gian được. Phòng bệnh hơn chữa bệnh. Phòng là chính

ndu96081631 · 24/1/14

Hoàng Trọng Nghĩa đã viết:
Bó tay, ăn gian thì dễ, chống ăn gian sao được Thầy ơi!

Ai mà biết đâu nè
Nhưng kinh nghiệm của tôi: Đôi khi cảm thấy vấn đề ấy không thể giải quyết nhưng thật ra vẫn có cách. Cứ suy nghĩ đi, nhiều khi có thể tìm được "gì đó" trong trái ổi đấy

Hoàng Trọng Nghĩa · 24/1/14

Tặng thêm cho các bạn phiên bản có nhạc!

Các bạn theo đường dẫn dưới đây, tải file Rar về, giải nén, chép folder QuaySo vào ổ đĩa nào đó rồi trải nghiệm với file có âm nhạc vui tươi.

Lưu ý, file Excel luôn luôn để cạnh với folder Media nhé các bạn, nói chung là 2 mục này phải để chung trong 1 folder.

http://www.mediafire.com/download/888razkss8qrua8/QuaySo.rar

CHÚC CÁC BẠN VUI VẺ!

Miền Cát Trắng · 9/6/14

Hi, Anh Nghĩa em xem chương trình quay số trúng thưởng anh làm thấy rất tiện ích và có thể ứng dụng được nhiều lĩnh vực.
Tuy nhiên còn một trường hợp em muốn chọn các số theo ý muốn cần để quay được không ạ, anh có thể bổ sung giúp em ứng dụng này được không ạ.

Vi dụ câu hỏi em đặt trong file kèm ạ.
Anh xem có cách nào không giúp em với ạ.
Em cảm ơn anh!

siwtom · 13/6/14

Miền Cát Trắng đã viết:
Hi, Anh Nghĩa em xem chương trình quay số trúng thưởng anh làm thấy rất tiện ích và có thể ứng dụng được nhiều lĩnh vực.
Tuy nhiên còn một trường hợp em muốn chọn các số theo ý muốn cần để quay được không ạ, anh có thể bổ sung giúp em ứng dụng này được không ạ.

Vi dụ câu hỏi em đặt trong file kèm ạ.
Anh xem có cách nào không giúp em với ạ.
Em cảm ơn anh!

Việc giải quyết không có gì khó cả. Chỉ có điều code của người khác, lại dài, nên tôi rất ngại đọc. Nhiều khi sửa một chỗ nhưng do nó có liên quan tới nhiều nơi nên phải dò để sửa hết, rất mất công.
Thôi thì tôi thử, không chuẩn thì chịu thôi.

Việc chọn 1 tập số để chỉ rút trong những số đó thì giải quyết quá đơn giản.
Giả sử bạn có 200 số đã chọn. Bạn hãy nhập vào A1:A200 trên sheet "Quay_So".
Ở chỗ cần phải nhập số (cửa sổ đầu tiên) thì nhập 200.
Cứ cho ct quay số thoải mái. Nếu nó chọn ra k, với 1 ≤ k ≤ 200 thì ta "coi như là" nó đã chọn số ở cell Ak. Thế thôi.

Để giải quyết thì bạn vào xem code của Form có tên là UsfQuaySo2. Trong đó có Private Sub cmdStart_Click()

Mã:

Private Sub cmdStart_Click()
    With cmdStart
        ................
            Do
                Randomize
                pri_iRnd = Int((pri_Dic.Count) * Rnd()) + 1
                tbxNguon[COLOR=#ff0000][/COLOR][B][COLOR=#ff0000] [/COLOR][/B][COLOR=#ff0000][/COLOR]=[COLOR=#ff0000][/COLOR][B][COLOR=#ff0000] pri_Dic.Item(pri_iRnd)[/COLOR][/B]
                Sleep 10
                DoEvents
                If .Caption = QS.Caption Or pri_GameOver = True Then GoTo Ends
            Loop
Ends:
            If pri_GameOver = True Then Exit Sub
            With lstDanhSach
                .AddItem .ListCount + 1
                .List(.ListCount - 1, 1)[COLOR=#ff0000][/COLOR][B][COLOR=#ff0000] [/COLOR][/B][COLOR=#ff0000][/COLOR]=[COLOR=#ff0000][/COLOR][B][COLOR=#ff0000] pri_Dic.Item(pri_iRnd)[/COLOR][/B]
                .ListIndex = .ListCount - 1
            End With
            k = k + 1
            pri_DicCount = pri_DicCount - 1
            pri_Dic.Remove pri_iRnd
            Call CapNhatDict
            Call NhacNgungLai
        Else
            .Caption = QS.Caption
            .BackColor = MauXanhNhat
        End If
    End With
End Sub

2 dòng đỏ đỏ đổi thành

Mã:

tbxNguon[B][COLOR=#0000ff] [/COLOR][/B][COLOR=#0000ff][/COLOR]=[COLOR=#0000ff][/COLOR][B][COLOR=#0000ff] Sheets("Quay_So").Cells([/COLOR][COLOR=#ff0000]pri_Dic.Item(pri_iRnd)[/COLOR][COLOR=#0000ff], 1)
[/COLOR][/B]...[B][COLOR=#0000ff]
[/COLOR][/B][COLOR=#0000ff][/COLOR].List(.ListCount - 1, 1)[COLOR=#0000ff][/COLOR][B][COLOR=#0000ff] [/COLOR][/B][COLOR=#0000ff][/COLOR]=[COLOR=#0000ff][/COLOR][B][COLOR=#0000ff] Sheets("Quay_So").Cells([/COLOR][COLOR=#ff0000]pri_Dic.Item(pri_iRnd)[/COLOR][COLOR=#0000ff], 1)[/COLOR][/B]

Miền Cát Trắng · 13/6/14

Cháu cảm ơn Chú Siwtom đã dành thời gian tìm hiểu và giúp cháu ạ! Hihi,Cháu chạy thử thấy không có lỗi gì rồi.
Nhưng vẫn thiếu một trường hợp bắt lỗi nữa nếu dánh sách chỉ có 200 người mà nhập >200 thì sẽ thông báo lỗi giống như >999 đó ạ.
Chú xử lý giúp cháu với ạ.
------------------
Dear Anh Nghĩa ,Em muốn thêm một cột Tên người cạnh cột số may mắn được không ạ. giả sử sanh sách tên người sẽ từ xuất phát từ ô B1 ạ.
Chú Siwtom nếu có hứng thú thì xem giúp cháu với ạ.
Hihi, chương trình sẽ rất tiện ích một lần nữa cảm ơn Anh Nghĩa và Chú Siwtom.

siwtom · 13/6/14

Miền Cát Trắng đã viết:
Cháu cảm ơn Chú Siwtom đã dành thời gian tìm hiểu và giúp cháu ạ! Hihi,Cháu chạy thử thấy không có lỗi gì rồi.
Nhưng vẫn thiếu một trường hợp bắt lỗi nữa nếu dánh sách chỉ có 200 người mà nhập >200 thì sẽ thông báo lỗi giống như >999 đó ạ.
Chú xử lý giúp cháu với ạ.
------------------
Dear Anh Nghĩa ,Em muốn thêm một cột Tên người cạnh cột số may mắn được không ạ. giả sử sanh sách tên người sẽ từ xuất phát từ ô B1 ạ.
Chú Siwtom nếu có hứng thú thì xem giúp cháu với ạ.
Hihi, chương trình sẽ rất tiện ích một lần nữa cảm ơn Anh Nghĩa và Chú Siwtom.

Thôi bạn không phải nhập gì cả. Code sẽ tự điền số lượng số.

1. Mở code của UsfQuaySo1 và thay Private Sub UserForm_Initialize() cũ bằng

Mã:

Private Sub UserForm_Initialize()
[COLOR=#ff0000]Dim lastRow As Long[/COLOR]
    pri_hWnd = FindWindow("ThunderDFrame", Caption)
    pri_OldWidth = Width: pri_OldHeight = Height
    lblHuongDan3.Top = lblHuongDan2.Top
    pri_AllowResize = True
    
    [COLOR=#ff0000]lastRow = Sheets("Quay_So").[A65536].End(xlUp).Row
    If lastRow > 999 Then lastRow = 999
    txbSoPhieu = lastRow
    txbSoPhieu.Locked = True    
    cmdNhapPhieu.SetFocus[/COLOR]
End Sub

Đỏ đỏ là mới thêm

2. Nhập dữ liệu vào cột A từ A1. Dữ liệu có thể là số, mã nhân viên, họ tên, tóm lại là bất kỳ. Có thể vài mã, vài họ tên lẫn lộn, không nhất thết phải là số và không nhất thiết cùng kiểu số hay chữ.

Tôi không hiểu bạn cần cả số cả tên người làm gì.
Nếu bạn có danh sách họ tên thì nhập thẳng vào cột A. Lúc đó trong "cột số may mắn" và textbox "Số phiếu may mắn" sẽ chỉ có toàn tên. Tất nhiên lúc đó nên sửa 2 Label thành "Người may mắn".

Miền Cát Trắng · 13/6/14

siwtom đã viết:
Thôi bạn không phải nhập gì cả. Code sẽ tự điền số lượng số.

1. Mở code của UsfQuaySo1 và thay Private Sub UserForm_Initialize() cũ bằng

Mã:

Private Sub UserForm_Initialize() [COLOR=#ff0000]Dim lastRow As Long[/COLOR] pri_hWnd = FindWindow("ThunderDFrame", Caption) pri_OldWidth = Width: pri_OldHeight = Height lblHuongDan3.Top = lblHuongDan2.Top pri_AllowResize = True [COLOR=#ff0000]lastRow = Sheets("Quay_So").[A65536].End(xlUp).Row If lastRow > 999 Then lastRow = 999 txbSoPhieu = lastRow txbSoPhieu.Locked = True cmdNhapPhieu.SetFocus[/COLOR] End Sub

Đỏ đỏ là mới thêm

2. Nhập dữ liệu vào cột A từ A1. Dữ liệu có thể là số, mã nhân viên, họ tên, tóm lại là bất kỳ. Có thể vài mã, vài họ tên lẫn lộn, không nhất thết phải là số và không nhất thiết cùng kiểu số hay chữ.

Tôi không hiểu bạn cần cả số cả tên người làm gì.
Nếu bạn có danh sách họ tên thì nhập thẳng vào cột A. Lúc đó trong "cột số may mắn" và textbox "Số phiếu may mắn" sẽ chỉ có toàn tên. Tất nhiên lúc đó nên sửa 2 Label thành "Người may mắn".

Một lần nữa cháu xin cảm ơn chú, giờ cháu mới biết đến điều đó.
Ngoài ra cháu muốn hỏi Chú thêm nếu chuyển danh sách từ địa chỉ A1:A thành địa chỉ C2:C thì code có phải sửa lại rắc rối không ạ, sở dĩ cháu hỏi vậy vì phải tùy biến theo bảng số liệu bao gồm cả tiêu đề nữa ạ.

siwtom · 14/6/14

Miền Cát Trắng đã viết:
Một lần nữa cháu xin cảm ơn chú, giờ cháu mới biết đến điều đó.

Tôi nói là nhập các số vào cột A chỉ vì trong bài #12 bạn viết

em muốn chọn các số theo ý muốn

Nhìn vào code trong bài #13

Mã:

tbxNguon= Sheets("Quay_So").Cells(pri_Dic.Item(pri_iRnd), 1)
...
.List(.ListCount - 1, 1)= Sheets("Quay_So").Cells(pri_Dic.Item(pri_iRnd), 1)

Ta thấy là ListBox và TextBox nhặt dữ liệu từ các ô trong cột A. Không có chỗ nào nói dữ liệu phải là số cả.

Ngoài ra cháu muốn hỏi Chú thêm nếu chuyển danh sách từ địa chỉ A1:A thành địa chỉ C2:C thì code có phải sửa lại rắc rối không ạ, sở dĩ cháu hỏi vậy vì phải tùy biến theo bảng số liệu bao gồm cả tiêu đề nữa ạ.

Tôi thấy bạn đọc code mà không hiểu nên tôi sẽ tạo một biến để nhập ô đầu tiên của dữ liệu, vd. A1, C2 hoặc tùy ý. Lúc tùy biến thì bạn chỉ phải sửa 1 chỗ duy nhất mà thôi.

1. Trong code của module mdlPublic ở gần đầu có dòng

Mã:

[COLOR=#0000ff]Public pub_Music As String, pub_Path As String, pub_SongList[/COLOR]

Bạn thêm một dòng ở bên dưới có nội dung

Mã:

Public cellStart As Range

2. Trong code của Private Sub cmdStart_Click trong UsfQuaySo2 có 2 dòng đã nói ở bài #13

Mã:

tbxNguon= ...
...
.List(.ListCount - 1, 1)= ...

Code mới của 2 dòng đó là

Mã:

tbxNguon = cellStart.Offset(pri_Dic.Item(pri_iRnd) - 1).Value
...
.List(.ListCount - 1, 1) = cellStart.Offset(pri_Dic.Item(pri_iRnd) - 1).Value

3. Code mới của Private Sub UserForm_Initialize trong code của UsfQuaySo1

Mã:

Private Sub UserForm_Initialize()
Dim count As Long
    pri_hWnd = FindWindow("ThunderDFrame", Caption)
    pri_OldWidth = Width: pri_OldHeight = Height
    lblHuongDan3.Top = lblHuongDan2.Top
    pri_AllowResize = True
    
    Set cellStart = [B][COLOR=#ff0000][A1][/COLOR][/B]
    count = cellStart.End(xlDown).Row - cellStart.Row + 1
    If count > 999 Then count = 999
    txbSoPhieu = count
    cmdNhapPhieu.SetFocus
End Sub

Đó là tất cả những gì bạn cần sửa. Mỗi lần thay đổi vị trí của dữ liệu thì chỉ sửa 1 chỗ duy nhất đỏ đỏ. Tức nhập ô đầu tiên của dữ liệu. Ví dụ bạn có C2:Cxyz thì nhập vào chỗ đỏ đỏ [C2]

Nhớ nhập dữ liệu không có dòng trống.

vuongtoituonglai · 14/6/14

Thầy ơi xem lại dùm em. Công ty em tới hơn 5000 nhân viên mà số phiếu chỉ cho nhập tối đa là 999 phiếu. Thầy chỉnh lại chổ này nhé. Để tiện cho người sử dụng Thầy thiết kế Form danh sách nhân viên bao gồm tên, mã nhân viên, bộ phận từ excel... sau đó sẽ import vào chương trình quay số thì sẽ tuyệt vời hơn.

KUMI · 14/6/14

Hôm rảnh rỗi được nghỉ làm em ngồi xem lại chương trình của anh Nghĩa thấy cũng hay hay :-=

.

vuongtoituonglai đã viết:
Thầy ơi xem lại dùm em. Công ty em tới hơn 5000 nhân viên mà số phiếu chỉ cho nhập tối đa là 999 phiếu. Thầy chỉnh lại chổ này nhé. Để tiện cho người sử dụng Thầy thiết kế Form danh sách nhân viên bao gồm tên, mã nhân viên, bộ phận từ excel... sau đó sẽ import vào chương trình quay số thì sẽ tuyệt vời hơn.

Code trong UsfQuaySo1 có đoạn:

Mã:

Private Sub txbSoPhieu_Change()
    If Val(txbSoPhieu) = 0 Or txbSoPhieu = "" Or Val(txbSoPhieu) > [COLOR=#800080][B]999[/B][/COLOR] Then
        lblHuongDan2.Visible = False
        cmdNhapPhieu.Visible = False
    Else
        lblHuongDan2.Visible = True
        cmdNhapPhieu.Visible = True
    End If
    If Val(txbSoPhieu) > [COLOR=#800080][B]999 [/B][/COLOR]Then
        lblHuongDan3.Visible = True
    Else
        lblHuongDan3.Visible = False
    End If
End Sub

Bạn sửa thành 9999 là được, và cũng thêm một số 9 vào trong: lblHuongDan3
Trong lblNgauNhien của UsfQuaySo2 bạn thêm 1 số 0 nữa.
Và code trong UsfQuaySo2 là:

Mã:

Private Sub lstDanhSach_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    With lstDanhSach
        If .ListCount = 0 Then Exit Sub
        If UniMsgBox(MsgXoa.Caption, vbQuestion + vbYesNo, "THÔNG BÁO") = vbYes Then
            .RemoveItem (.ListIndex)
            pri_SoLan = pri_SoLan - 1
            For i = 1 To pri_SoLan
                .List(i - 1, 0) = i
            Next i
            If .ListCount = 0 Then
                lblPhieuMM.Caption = PhieuMM.Caption & 1 & " / " & pub_SoPhieu
                lblNgauNhien.Caption = "000[COLOR=#ff0000][B]0[/B][/COLOR]"
                lblNgauNhien.ForeColor = MauXam
                lblSTT.Visible = False
                lblSoMayMan.Visible = False
                lstDanhSach.Visible = False
            Else
                lblPhieuMM.Caption = PhieuMM.Caption & pri_SoLan & " / " & pub_SoPhieu
                lblNgauNhien.Caption = .List(.ListCount - 1, 1)
            End If
        End If
    End With
    cmdStart.SetFocus
End Sub

Chỗ đo đỏ là chỗ thêm vào.
Bạn xem file kèm nhé.
Nếu bạn muốn có password VBA thì liên hệ riêng với Anh Nghĩa nhé đẹp zai nhé (^_-).

--------------------------------------

siwtom đã viết:
Việc giải quyết không có gì khó cả. Chỉ có điều code của người khác, lại dài, nên tôi rất ngại đọc. Nhiều khi sửa một chỗ nhưng do nó có liên quan tới nhiều nơi nên phải dò để sửa hết, rất mất công.
Thôi thì tôi thử, không chuẩn thì chịu thôi.

Việc chọn 1 tập số để chỉ rút trong những số đó thì giải quyết quá đơn giản.
Giả sử bạn có 200 số đã chọn. Bạn hãy nhập vào A1:A200 trên sheet "Quay_So".
Ở chỗ cần phải nhập số (cửa sổ đầu tiên) thì nhập 200.
Cứ cho ct quay số thoải mái. Nếu nó chọn ra k, với 1 ≤ k ≤ 200 thì ta "coi như là" nó đã chọn số ở cell Ak. Thế thôi.

Để giải quyết thì bạn vào xem code của Form có tên là UsfQuaySo2. Trong đó có Private Sub cmdStart_Click()

Mã:

Private Sub cmdStart_Click() With cmdStart ................ Do Randomize pri_iRnd = Int((pri_Dic.Count) * Rnd()) + 1 tbxNguon=[B][COLOR=#ff0000] pri_Dic.Item(pri_iRnd)[/COLOR][/B] Sleep 10 DoEvents If .Caption = QS.Caption Or pri_GameOver = True Then GoTo Ends Loop Ends: If pri_GameOver = True Then Exit Sub With lstDanhSach .AddItem .ListCount + 1 .List(.ListCount - 1, 1)=[B][COLOR=#ff0000] pri_Dic.Item(pri_iRnd)[/COLOR][/B] .ListIndex = .ListCount - 1 End With k = k + 1 pri_DicCount = pri_DicCount - 1 pri_Dic.Remove pri_iRnd Call CapNhatDict Call NhacNgungLai Else .Caption = QS.Caption .BackColor = MauXanhNhat End If End With End Sub

2 dòng đỏ đỏ đổi thành

Mã:

tbxNguon=[B][COLOR=#0000ff] Sheets("Quay_So").Cells([/COLOR][COLOR=#ff0000]pri_Dic.Item(pri_iRnd)[/COLOR][COLOR=#0000ff], 1) [/COLOR][/B]...[B][COLOR=#0000ff] [/COLOR][/B].List(.ListCount - 1, 1)=[B][COLOR=#0000ff] Sheets("Quay_So").Cells([/COLOR][COLOR=#ff0000]pri_Dic.Item(pri_iRnd)[/COLOR][COLOR=#0000ff], 1)[/COLOR][/B]

Em chào Thầy siwtom ạ!
Em thấy cách đưa số theo cách này sẽ tiện hơn rất nhiều vì có thể tự do tùy biến theo ý thích, Tuy nhiên nếu dùng theo cách này ta có thể ăn gian được theo cách nhập nhiều lần một số nào đó vào trong list như vậy tỷ lệ trúng sẽ rất cao,đúng không Thầy.
Hì, Nhưng có một chỗ đáng chú ý là khả năng số nhập vào nhiều lần đó cũng sẽ được trúng thưởng nhiều lần.Giả sử ta đưa 10 con số 86 vào trong list thì cơ hội trúng của số 86 sẽ rất cao có và có thể nhận được tối đa 10 giải thưởng.
Thầy giúp em sửa lại để nếu những số nhập vào nhiều lần như thế này thì chỉ nhận được một lần giải thôi không ạ nghĩa là lần quay sau sẽ không được giải nữa ạ, hihi!
Ý em muốn nói cũng giống như là bốc thăm vậy lá phiếu nào được lấy ra khỏi thùng thì loại, không được bỏ vào thùng nữa ,phải dành lượt cho người sau nữa Thầy ạ.

Cảm ơn Thầy!

siwtom · 14/6/14

KUMI đã viết:
Hôm rảnh rỗi được nghỉ làm em ngồi xem lại chương trình của anh Nghĩa thấy cũng hay hay .

Em chào Thầy siwtom ạ!
Em thấy cách đưa số theo cách này sẽ tiện hơn rất nhiều vì có thể tự do tùy biến theo ý thích, Tuy nhiên nếu dùng theo cách này ta có thể ăn gian được theo cách nhập nhiều lần một số nào đó vào trong list như vậy tỷ lệ trúng sẽ rất cao,đúng không Thầy.
Hì, Nhưng có một chỗ đáng chú ý là khả năng số nhập vào nhiều lần đó cũng sẽ được trúng thưởng nhiều lần.Giả sử ta đưa 10 con số 86 vào trong list thì cơ hội trúng của số 86 sẽ rất cao có và có thể nhận được tối đa 10 giải thưởng.
Thầy giúp em sửa lại để nếu những số nhập vào nhiều lần như thế này thì chỉ nhận được một lần giải thôi không ạ nghĩa là lần quay sau sẽ không được giải nữa ạ, hihi!
Ý em muốn nói cũng giống như là bốc thăm vậy lá phiếu nào được lấy ra khỏi thùng thì loại, không được bỏ vào thùng nữa ,phải dành lượt cho người sau nữa Thầy ạ.

Cảm ơn Thầy!

Sửa code của người khác rất mệt vì phải đọc toàn bộ code để biết nó làm gì, để biết khi sửa "chỗ này" thì phải sửa cả "chỗ kia".

Gọi là chơi vui chứ có phải quay tiền bạc tỷ, thắng ô tô đâu mà chơi trò ăn gian.
Về việc loại những "mục" đã được quay thì nếu tôi không lầm thì code của Nghĩa có loại.

Sửa kiểu chắp vá thì không khó. Nếu không muốn thay đổi nhiều trong code đã có thì vd. có thể lọc duy nhất dữ liệu trong cột "bí mật" --> xóa dữ liệu cũ trong cột "bí mật" --> đập dữ liệu đã lọc trở lại cột "bí mật" --> lúc mày mới thực hiện

Mã:

    count = cellStart.End(xlDown).Row - cellStart.Row + 1
    If count > 999 Then count = 999
    txbSoPhieu = count
    cmdNhapPhieu.SetFocus

Cũng có thể không xóa/đập trở lại làm gì. Ta tạo dic sau đó: lọc duy nhất dữ liệu trong cột "bí mật" vào dic với key = 1, 2, 3, ... còn Item = dữ liệu lọc.. Sau đó

Mã:

    count = dic.count
    If count > 999 Then count = 999
    txbSoPhieu = count
    cmdNhapPhieu.SetFocus

Và

Mã:

tbxNguon = dic.Item(pri_Dic.Item(pri_iRnd))
...
.List(.ListCount - 1, 1) = dic.Item(pri_Dic.Item(pri_iRnd))

DIC thì bàn nhiều, học nhiều rồi nên ai cần thì cứ tìm và tham khảo thôi.

Tôi viết chay trong notepad nên có thể nhầm lẫn.
-------------
Quà của bạn Nghĩa, code của bạn Nghĩa, tác phẩm của bạn Nghĩa. Ai có yêu cầu sửa thì liên hệ với Nghĩa. Tôi dừng ở đây.

Mà bạn Nghĩa kể cũng lạ. Quà của bạn mà có người hỏi bạn chỉ âm thầm đứng cười. Nếu không muốn sửa thì cũng nói với người hỏi một câu chứ nhỉ. Tôi vào trả lời chẳng qua là bạn Miền Cát Trắng nhờ và tôi đã trót lao vào chứ tôi không quan tâm. Nhưng bây giờ là tôi ngừng.
-----
Mà tôi tự ý sửa tác phẩm của bạn Nghĩa mà không xin phép. Chỉ sợ gặp rồi họ xin tí tiết thì toi đời tôi.

KUMI · 14/6/14

siwtom đã viết:
Gọi là chơi vui chứ có phải quay tiền bạc tỷ, thắng ô tô đâu mà chơi trò ăn gian.

Hì, Thầy ơi! nói ăn gian chung chung vậy chứ nhưng cũng có nhiều tình huống đôi khi cũng cần lắm chứ.
Ví dụ ở cơ quan em năm vừa rồi có những người công hiến đặc biệt chẳng hạn ngoài tiêu chí xét thưởng ra thì ta cho họ thêm cơ hội chẳng hạn. Và nhất là trên diễn đàn có những nguy cơ bất cập gì ta cũng nên bàn đến phải không Thầy.

siwtom đã viết:
Về việc loại những "mục" đã được quay thì nếu tôi không lầm thì code của Nghĩa có loại.

Em không hiểu gì về code lắm nhưng lúc test em thấy trường hợp đã nêu ở trên là có xảy ra Thầy ạ.
Có thể Anh nghĩa chỉ áp dụng code loại trong trường hợp các số tự nhiên đưa vào tư 1 đến 999 hoặc đến n thôi ạ.
Còn khi đã nhập các số cần quay vào list danh sách trong sheets Quay_Số thì code loại số trùng này của anh Nghĩa không còn tác dụng nữa...
Hix, em không hiểu gì code chỉ đoán mò qua việc thử thôi ạ.

siwtom đã viết:
Mà tôi tự ý sửa tác phẩm của bạn Nghĩa mà không xin phép

Spam thêm chút ạ:
Hix,như Thầy nói chắc em cũng bị tội hihi,nếu có gì không phải Anh Nghĩa đừng giận em nhé!

siwtom đã viết:
Chỉ sợ gặp rồi họ xin tí tiết thì toi đời tôi.

Anh Nghĩa chỉ được cái nhiệt tình và chạy theo phong trào thôi Thầy ạ, chứ nhát lắm! Thầy thấy đấy đẹp trai và giỏi giang như vậy mà đến giờ vẫn ợ độc thân --> kiểu này chắc là gái còn không dám tán huống chi là xin tiết của người khác __--__

siwtom đã viết:
Quà của bạn Nghĩa, code của bạn Nghĩa, tác phẩm của bạn Nghĩa. Ai có yêu cầu sửa thì liên hệ với Nghĩa. Tôi dừng ở đây.

Em nghĩ cái này cũng có một chút gọi là trao đổi để học hỏi và đưa ra giải pháp vì mỗi người một sở thích,Nhưng Thầy đã tôn trọng và cho vấn đề này thuộc về riêng tư nhiều hơn thì em cũng xin rút kinh nghiêm ạ!

Em cảm ơn Thầy đã giúp em!

vuongtoituonglai · 15/6/14

Chương trình hay quá, Mình muốn sửa số người tham dự là một con số lớn hơn 999(chẳn hạn 9999 người tham dự) nhưng không biết phải làm sao. Chủ nhân của tác phẩm chỉnh dùm mình chổ này nhé!
Cảm ơn.

KUMI · 15/6/14

vuongtoituonglai đã viết:
Chương trình hay quá, Mình muốn sửa số người tham dự là một con số lớn hơn 999(chẳn hạn 9999 người tham dự) nhưng không biết phải làm sao. Chủ nhân của tác phẩm chỉnh dùm mình chổ này nhé!
Cảm ơn.

Hix, bạn chưa đọc các bài trước đó à!
Mình đã trả lời cho bạn trong bài câu hỏi này rồi mà:

vuongtoituonglai đã viết:
Thầy ơi xem lại dùm em. Công ty em tới hơn 5000 nhân viên mà số phiếu chỉ cho nhập tối đa là 999 phiếu. Thầy chỉnh lại chổ này nhé. Để tiện cho người sử dụng Thầy thiết kế Form danh sách nhân viên bao gồm tên, mã nhân viên, bộ phận từ excel... sau đó sẽ import vào chương trình quay số thì sẽ tuyệt vời hơn.

Câu Trả Lời

vuongtoituonglai · 16/6/14

KUMI đã viết:
Hix, bạn chưa đọc các bài trước đó à!
Mình đã trả lời cho bạn trong bài câu hỏi này rồi mà:

Câu Trả Lời

Thật sự là mình thấy bạn trả lời câu hỏi của mình rồi nhưng trong file mình tải về chỉ có một file một file duy nhất đó là file "RutThamGPE_NewVersion" cứ lay hoay tìm chổ sửa code như bạn chỉ nhưng không biết tìm chổ nào để sửa. Mình chọn phím Alt+F11 nhưng cũng không thấy code đâu cả.

ma_trix · 31/10/14

Ai có pass cho mình xin với, mình nhắn tin cho Nghĩa không được, cám ơn rất nhiều

vuongnv · 5/1/15

Mọi người cho em xin pass với ạ, em gửi tin nhắn cho anh Nghĩa nhưng không được. Cám ơn ạ

letinnghia · 5/1/15

Hoàng Trọng Nghĩa đã viết:
Các bạn theo đường dẫn dưới đây, tải file Rar về, giải nén, chép folder QuaySo vào ổ đĩa nào đó rồi trải nghiệm với file có âm nhạc vui tươi.

CHÚC CÁC BẠN VUI VẺ!

Anh Hoàng Trọng Nghĩa Ơi, có cách nào danh sách trúng thưởng được lấy từ file excel bao gồm MNV, họ và tên, bộ phận và hình của từng nhân viên(Mục đích là khi người trúng thưởng sẽ hiện thông tin như: MNV, tên, bộ phận và hình của nhân viên đó) rất mong nhận được sự giúp đỡ của anh. Chân Thành Cảm Ơn

thang24 · 22/10/16

Rất hay và ý nghĩa, tuy nhiên mình muốn đến lần quay thứ 10 thì fix ra một số cố định giả sử 40 được không bạn? vì có nhiều trường hợp mình cần phải tặng quà cho người kém may mắn mà ko sợ họ tự ti

Minhhanh_89 · 10/12/16

Hi anh,
Em không có mở cửa sổ VBA của file được, em muốn chỉnh sửa số phiếu quay lớn hơn ạ. Anh có thể gửi cho em xin file để em điều chỉnh form và số lượng không ạ.
Em cảm ơn

Bonito89 · 30/1/18

Dear anh Nghĩa!
Trước hết rất cảm ơn anh vì file này, tôi thấy nó rất hữu ích.
Cho tôi hỏi nếu bốc thăm trúng thưởng có 10 loại giải thưởng từ giải 10 đến giải đặc biệt (số lượng quà mỗi vòng giảm dần). Muốn quay thưởng từng vòng riêng biệt thì làm sao để loại được những số đã quay trúng rồi? Rất mong nhận được phản hồi từ anh.
Cảm ơn anh./.

Nguyễn Ngọc 1988 · 23/10/19

E thấy chương trình rất hay. Cho e hỏi e có cơ cấu là 10 giải kk, 5 giải 3, 2 giải 2 và 1 giải nhất. Sau khi quay hết 10 giải kk thì sẽ reset để quay giải tiếp theo, nhưng làm thế nào để những người đã có tên ở các giải trc thì sẽ ko xuất hiện ở những lần quay tiếp theo nữa ạ. E xin dc nhờ các anh/ chị giúp đỡ. Xin cảm ơn.

Vanchung8x · 7/12/19

Nguyễn Ngọc 1988 đã viết:
E thấy chương trình rất hay. Cho e hỏi e có cơ cấu là 10 giải kk, 5 giải 3, 2 giải 2 và 1 giải nhất. Sau khi quay hết 10 giải kk thì sẽ reset để quay giải tiếp theo, nhưng làm thế nào để những người đã có tên ở các giải trc thì sẽ ko xuất hiện ở những lần quay tiếp theo nữa ạ. E xin dc nhờ các anh/ chị giúp đỡ. Xin cảm ơn.

Share link cho mình với

Bài đã được tự động gộp: 7/12/19

Hoàng Trọng Nghĩa đã viết:
Tặng thêm cho các bạn phiên bản có nhạc!

Các bạn theo đường dẫn dưới đây, tải file Rar về, giải nén, chép folder QuaySo vào ổ đĩa nào đó rồi trải nghiệm với file có âm nhạc vui tươi.

Lưu ý, file Excel luôn luôn để cạnh với folder Media nhé các bạn, nói chung là 2 mục này phải để chung trong 1 folder.

http://www.mediafire.com/download/888razkss8qrua8/QuaySo.rar

CHÚC CÁC BẠN VUI VẺ!

A Nghĩa ơi chia sẻ version mới nhất được không?

bkit_spk_2012 · 10/12/19

admin ơi, cho em hỏi là em mở file ra thì báo lỗi này là thế nào.

phuoclocvl · 7/5/21

Hoàng Trọng Nghĩa đã viết:
Nhân dịp Tết cổ truyền, có thể là tất niên và cũng có thể là tân niên, một số cty tổ chức rút thăm trúng thưởng, nếu như có một chương trình như thế này để vui chơi thì tạo thêm không khí tưng bừng cho ngày xuân phải không các bạn!

Không khác gì mấy với cách thức và giao diện của bài này:

http://www.giaiphapexcel.com/forum/showthread.php?51196-Tặng-các-bạn-file-QUAY-SỐ-TRÚNG-THƯỞNG-nhân-dịp-SN-GiaiphapExcel-Com-lần-5&p=323317#post323317

Nhưng lần cải tiến này đã thay đổi bên trong rất nhiều, cụ thể là trước đó chỉ dùng 1 UserForm để thực hiện quay số nên nhiều công đoạn rối rắm, nay dùng tới 2 UserForm cho việc này, đồng thời cải tiến code và giao diện đẹp hơn, hiệu quả hơn.

Từ bài viết này:

http://www.giaiphapexcel.com/forum/showthread.php?74484-Load-Shape-của-Sheet-lên-Button-của-Form&p=558617#post558617

tôi đã có cảm hứng và viết một ứng dụng dùng ngay cho hàm PictureFromObject nói trên, nó làm cho tôi khám phá nhiều hơn và tôi thật sự thích thú về điều đó.

Điểm nổi bật của chương trình lần này là người dùng không cần phải biết VBA cũng có thể đổi LOGO (hình ảnh) của công ty mình mà không phải Alt+F11 để đổi thủ công nữa! Chỉ cần bấm nút và thưởng thức!

Các bạn tải file về giải nén và trải nghiệm một ứng dụng từ hàm PictureFromObject của Thầy ndu96081631 nhé!

Dạ chào Anh,
Sao em dung pass minhthien321 mở vbaproject mà báo sai miết. Cho em xin lại pass với. Cảm ơn Anh

Tặng các bạn file "QUAY SỐ TRÚNG THƯỞNG" nhân dịp Tết cổ truyền. (1 người xem)

Người dùng đang xem chủ đề này

Chuyên gia GPE

File đính kèm

Thành viên hoạt động

Chuyên gia GPE

Thành viên hoạt động

Huyền thoại GPE

Chuyên gia GPE

Huyền thoại GPE

Chuyên gia GPE

Thành viên gắn bó

Huyền thoại GPE

Chuyên gia GPE

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

Thành viên gắn bó

Thành viên thường trực

Bụi phấn

Thành viên gắn bó

Bụi phấn

Thành viên thường trực

Bụi phấn

Thành viên thường trực

Thành viên mới

Thành viên mới

Thành viên hoạt động

Thành viên chính thức

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên thường trực

Thời gian đếm ngược.