[[20101221150415]]　『抽選くじ』（えりか）　ページの最後に飛ぶ

『抽選くじ』（えりか）

Excel2000です。

年末の社内行事で従業員の中から１０人ほどに、抽選で

プレゼントを渡したいのですが、この抽選の過程を

プロジェクターで投影して演出したいと考えています。

以下のようなものができればベストなのですが、

アドバイスいただけるとうれしいです!!

①コマンドボタンまたはキーボードを押して始動

②停止は自動でも可

③あらかじめ2列の表に部署、氏名を入力しておき、

　その中から抽出。

④挙動として、まず部署が表示され、その後数秒経過後に

　氏名が表示される。

※自分で調べてみたところ、④以外はrand,rank,int関数を

　使って理想の形が再現できたのですが、先に部署を

　表示させ、その後に氏名が表示されるという演出が

　できませんでした。

よろしくお願いします。

 抽選までできているのでしたら、後はVBAで氏名の部分を図形で隠しておいて
 数秒後に図形を非表示にするか透明にしていくなどの方法もあります。
 ただ、10回連続で動かすということを考えると氏名を隠す前に次の人の氏名を
 表示してしまうというオペレーションミスが考えられるので、抽選から表示ま
 でを行う処理を一括でVBAにさせるのが無難だと思います。
 また、必要であれば同じ人に当たらないような制御をしたりも。
 次の抽選に行くという運用でもカバーできます。

 （やっちん）

 ご自身でいろいろ作られたので、余計なお世話ですが
 私ならというのを作ってみました。
 1枚目のシートは白紙に、2枚目のシートのA列に部署、B列に名前のリストを
 置き、下記のマクロをお試しください。

 ご質問への回答は、マクロ中  「'//  当選者の表示」の部分で、前後は蛇足
 です。

 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 Sub Loto()
    Dim listWS As Worksheet
    Dim dispWS As Worksheet

    Set dispWS = Worksheets(1)
    Set listWS = Worksheets(2)

    listWS.Columns(3).Clear
    dispWS.Cells.Clear
    dispWS.Cells.Interior.ColorIndex = 38

    '// 表示シートのフォーマット
    With dispWS
        .Columns(1).ColumnWidth = 10
        .Columns(2).ColumnWidth = 40
        .Columns(3).ColumnWidth = 40
        .Rows(1).RowHeight = 40
        .Rows(2).RowHeight = 50
        With .Range("B2:C2")
            .Borders.LineStyle = xlContinuous
            .Borders.Weight = xlMedium
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Interior.ColorIndex = 2
            .Font.Size = 36
        End With
    End With

    Dim r
    r = 1
    For i = 1 To 10 '// 当選人数
        dispWS.Range("B2:C2").Font.ColorIndex = 8
        For j = 1 To 12  '// ローテーション時間
            sk = Int(Rnd() * 20)
            For k = 1 To sk
                Sleep 10 * j
                r = r + 1
                If listWS.Cells(r, "A").Value = "" Then r = 1
                Do While listWS.Cells(r, "C") <> ""
                    r = r + 1
                    If listWS.Cells(r, "A").Value = "" Then r = 1
                Loop
                dispWS.Cells(2, "B").Value = listWS.Cells(r, "A").Value
                If j > 7 Then
                    dispWS.Cells(2, "C").Value = "******"
                Else
                    dispWS.Cells(2, "C").Value = listWS.Cells(r, "B").Value
                End If
            Next
        Next

        '//  当選者の表示
        dispWS.Range("B2:C2").Font.ColorIndex = 3
        Sleep 3000
        For n = 1 To Len(listWS.Cells(r, "B").Value)
            dispWS.Cells(2, "C").Value = Left(listWS.Cells(r, "B").Value, n)
            Sleep 2000
        Next
        MsgBox listWS.Cells(r, "B").Value & "さん、当選おめでとうございます。", vbOKOnly, "＊＊＊＊＊年末大抽選会＊＊＊＊＊"
        With dispWS.Range("A5")
            .Offset(i, 0).Resize(1, 2).Interior.ColorIndex = 2
            .Offset(i, 0).Resize(1, 2).Borders.LineStyle = xlContinuous
            .Offset(i, 0).Value = listWS.Cells(r, "A").Value
            .Offset(i, 1).Value = listWS.Cells(r, "B").Value & "さん"
        End With
        listWS.Cells(r, "C").Value = "◎"
    Next
 End Sub
 (Mook)

コメント返信：

[ 一覧(最新更新順) ]

[[20101221150415]] 『抽選くじ』（えりか） ページの最後に飛ぶ

[[20101221150415]]　『抽選くじ』（えりか）　ページの最後に飛ぶ