|
くじの結果を菱形のオートシェイプで表示しています。
|
|
|
| シートコード |
|
下記のコードに変更してください。
'クジがクリックされた
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
下記のコードを追加してください。
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
|
|
|
|
|
|
|
|