Excelで三角くじを作ってみよう

Step 11 くじの結果(あたり/はずれ)を作成する

クジがクリックされると、透明な菱形のオートシェイプをクジ表示範囲の中央付近に作成し、徐々に透明度を低くしていきます。
次に、文字を徐々に大きくしていきます。
当たり・はずれは、Step5の「当たりを乱数で作成する」の結果の配列で判定しています。
はずれは黒色で当たりは赤色で表示します。


Homeへ > Excelでアプリケーションソフト2 > 三角くじを作ってみよう

シート画面

くじの結果を菱形のオートシェイプで表示しています。
はずれくじの表示


シートのVBAコード

下記のVBAコードに変更してください。

'クジがクリックされた
Public Sub ExShapeClick()
    Dim kname As String
    Dim tshape As Shape
    Dim nno As Long
    
    'クジの名前を取得
    kname = Application.Caller
    'クジ番号
    nno = Mid(kname, 5)
        
    For Each tshape In Sheets("くじ引き").Shapes
        '名前をチェック
        If tshape.name = kname Then
            '中央に移動
            ExMoveCenter tshape
            If atarikuji(nno) = 1 Then
                ExMakeClickShape True
            Else
                ExMakeClickShape False
            End If
            Exit For
        End If
    Next
    Set tshape = Nothing
End Sub

下記のVBAコードを追加してください。

Sub ExMakeClickShape(bsw As Boolean)
    Dim tshape As Shape
    Dim xc As Long
    Dim yc As Long
    Dim i As Integer
    
    'くじ描画範囲の中央位置を算出
    xc = (Sheets("くじ引き").Range("A1:K20").Width - 350) / 2
    yc = (Sheets("くじ引き").Range("A1:K20").Height - 350) / 2 + 50
    
    Set tshape = Sheets("くじ引き").Shapes.AddShape(Type:=msoShapeFlowchartDecision, Left:=xc, Top:=yc, Width:=350, Height:=350)

    '塗りつぶし
    tshape.Fill.Visible = True
    '透明度
    tshape.Fill.Transparency = 1
    '塗りつぶし色
    tshape.Fill.ForeColor.RGB = RGB(200, 249, 254)
    
    If bsw Then
        '文字をセット
        tshape.TextFrame.Characters.Text = "当たり"
    Else
        '文字をセット
        tshape.TextFrame.Characters.Text = "はずれ"
    End If
    
    '太字
    tshape.TextFrame.Characters.Font.Bold = True
    'サイズ
    tshape.TextFrame.Characters.Font.Size = 1
    '中央に表示
    tshape.TextFrame.HorizontalAlignment = xlCenter
    '中央に表示
    tshape.TextFrame.VerticalAlignment = xlCenter
    
    For i = 1 To 10
        '透明度
        tshape.Fill.Transparency = (10 - i) / 10
        'サイズ
        tshape.TextFrame.Characters.Font.Size = 2
        ExTimer 200
    Next
    
    If bsw Then
        '文字色
        tshape.TextFrame.Characters.Font.ColorIndex = 3
    Else
        '文字色
        tshape.TextFrame.Characters.Font.ColorIndex = 1
    End If
    
    For i = 1 To 13
        'サイズ
        tshape.TextFrame.Characters.Font.Size = i * 4
        ExTimer 200
    Next
    
    Set tshape = Nothing
End Sub


Homeへ > Excelでアプリケーションソフト2 > 三角くじを作ってみよう

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved