引かれたくじを回転させながら中央に移動する

三角くじを作ってみよう

Step 10　引かれたくじを回転させながら中央に移動する

クリックされたシェイプのオブジェクトを直接取得できないようなので、全シェイプを名前が一致するまでループし取得しています。直接取得する方法がおわかりの方教えてください。
オートシェイプのクジがクリックされると、回転しながら描画位置の中央に移動させます。
回転は　IncrementRotation　で10度単位で50回行います。
位置は現在位置を50で割り、分割分だけ50回移動させます。
その後、削除します。

シートコード
	下記のコードを追加してください。 Option Explicit 'Windowsが起動してからの経過時間 API Private Declare Function GetTickCount Lib "kernel32" () As Long 'タイマー Private Sub ExTimer(tim As Long) Dim st As Long '開始時間を取得 st = GetTickCount DoEvents Do If GetTickCount - st >= tim Then '時間が経過した Exit Do End If DoEvents Loop End Sub '中央に移動 Private Sub ExMoveCenter(tshape As Shape) Dim xc As Long Dim yc As Long Dim i As Long Dim xf As Double Dim yf As Double 'くじ描画範囲の中央位置を算出 xc = (Sheets("くじ引き").Range("A1:K20").Width - tshape.Width) / 2 yc = (Sheets("くじ引き").Range("A1:K20").Height - tshape.Height) / 2 xf = (xc - tshape.Left) / 50 yf = (yc - tshape.Top) / 50 For i = 1 To 50 tshape.Left = tshape.Left + xf tshape.Top = tshape.Top + yf '回転させる tshape.IncrementRotation 10 'タイマー ExTimer 10 Next '削除 tshape.Delete End Sub 下記のコードに変更してください。 Public Sub ExShapeClick() Dim kname As String Dim tshape As Shape 'クジの名前を取得 kname = Application.Caller Range("A1") = kname 'クジ番号 Range("A2") = Mid(kname, 5) For Each tshape In Sheets("くじ引き").Shapes '名前をチェック If tshape.name = kname Then '中央に移動 ExMoveCenter tshape Exit For End If Next Set tshape = Nothing End Sub

Topへ