ExcelのVBAについて

質問

ExcelのVBAを使って
縦20のセル、横30のセルの枠を作り
枠内で●が動き、枠に当たると跳ね返りの
繰り返しプログラムが作りたいんですが…

プログラムはここまでできています↓

Sub 試作品()
Dim hara As Integer, kyo As Integer
Dim X As Integer, Y As Integer
Dim V As String
Dim hyouji As String

hyouji = "●" 'hyoujiという変数に●を入れる
X = 1 'Xに１を入れる
Y = 1

V = ""
V = "上"

'------------------------------------------
Do
Cells(X, Y).Value = hyouji 'XとYの位置にあるセルに●を表示
For hara = 0 To 10000 '
For kyo = 0 To 1000 'タイマーの役割
Next '
Next '

Cells(X, Y).Value = "" 'XとYの位置にあるセルに●を消す
For hara = 0 To 10000 '
For kyo = 0 To 1000 'タイマーの役割
Next '
Next '

If V = "上" Then '上から来た●なら
X = X + 1 'Xに１を足す
Y = Y + 1
Else: V = "下" '下から来た●なら
X = X - 1 'Xから１を引く
Y = Y - 1
End If

If X = 20 Then 'Xが20になったら
V = "下" 'ループ外で定義した"上"を下に反転させる
ElseIf X = 1 Then 'Xが１になったら
V = "上" '下を上に反転
End If

If Y = 30 Then
V = "下"
ElseIf Y = 1 Then
V = "上"
End If

Loop
'------------------------------------------

End Sub

できたらこのプログラムに追加して
作成したいのですが…
この際できれば嬉しいので
これ以外のプログラムがあれば
教えて欲しいです。

VBA得意な方、お願いします;;

回答No.3

fujillin

No1です。

VBAに限らず得意じゃないけど、シェイプを移動する例を作ってみました。
単に移動するだけではつまらないので、スピードと球のサイズを変更できるようにしてあります。（ので、長くなってます←単に要領が悪いだけ？）

・移動範囲その他は初期設定値で変更できますが、値のチェックは行っ
　ていません。　（＝設定によっては変なことになる）
・画面のリフレッシュで、セルの罫線が多少ちらつくので、最初にセル
　全体を白色にしちゃっています。
・移動用のオートシェイプが無い場合は、勝手に作成します。
・↑↓キーでスピードが変化します。（↑：増、↓：減）
　また←→キーで球のサイズが変わります。（←：小、→：大）
　なお、実行停止はスペースキーです。
・計算方法は基本的に同じだと思いますが、球のサイズが変わるので、
　一応、球の中心位置を基準に計算するようにしています。

方向も変えられるようにしたり、障害物を置けるようにしたりすると、もっと面白くなるかも…？

DefSng B
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Sub Sample()
Dim ball As Shape, shp, timr As Long, i As Integer
Dim bPosition(1), bDirection(1), bSize, bSpeed, btmp
Dim bAreaMin(1), bAreaMax(1), endFlag As Integer

Const xMin = 100　　'//x座標の最小値
Const xMax = 500　　'//x座標の最大値
Const yMin = 100　　'//y座標の最小値
Const yMax = 500　　'//y座標の最大値
Const xDelta = 3.5　'//x方向の増加量（移動量）
Const yDelta = 2　　'//y方向の増加量（移動量）
Const ballSize = 9　'//初期サイズ(3～50)
Const sizeDef = 1.05　'//サイズの変化率
Const speed = 60　　'//移動速度（10～100）
Const speedDef = 1.05　'//速度の変化率
Const ballcolor = 10　'//ballの表示色(SchemeColor)

'//***********　初期設定　*************
'//変数の初期設定
bAreaMin(0) = xMin:　　　bAreaMin(1) = yMin
bAreaMax(0) = xMax:　　　bAreaMax(1) = yMax
bDirection(0) = xDelta:　bDirection(1) = yDelta
bSize = ballSize:　　　　bSpeed = speed
endFlag = 1

'//ballをセット、無い場合は作成
For Each shp In ActiveSheet.Shapes
If shp.Type = msoAutoShape And shp.Name = "move_ball" Then Set ball = shp
Next shp
If ball Is Nothing Then
　　Set ball = ActiveSheet.Shapes.AddShape(msoShapeOctagon, 100, 100, 10, 10)
　　ball.Name = "move_ball"
　　ball.Fill.Visible = msoTrue
　　ball.Fill.Solid
　　ball.Line.Visible = msoFalse
End If

'//画面、ballの初期設定（スタート位置はランダム）
Cells.Interior.ColorIndex = 2
Cells.Interior.Pattern = xlSolid
Randomize
bPosition(0) = Rnd * (bAreaMax(0) - bAreaMin(0) - 2 * bSize) + bSize
bPosition(1) = Rnd * (bAreaMax(1) - bAreaMin(1) - 2 * bSize) + bSize
ball.Fill.ForeColor.SchemeColor = ballcolor
ball.Left = bPosition(0): ball.Width = bSize
ball.Top = bPosition(1): ball.Height = bSize

'//***********　移動処理　*************
Do
'//時間調整（ウェイト）
timr = GetTickCount() + 1000 / bSpeed
Do: Loop While GetTickCount() < timr

'//入力キーチェック
If GetAsyncKeyState(vbKeySpace) <> 0 Then endFlag = 0
If GetAsyncKeyState(vbKeyUp) <> 0 Then bSpeed = bSpeed * speedDef
If GetAsyncKeyState(vbKeyDown) <> 0 Then bSpeed = bSpeed / speedDef
btmp = 1
If bSpeed > 100 Then btmp = 2 Else If bSpeed < 30 Then btmp = 0.5
bSpeed = bSpeed / btmp
bDirection(0) = btmp * bDirection(0)
bDirection(1) = btmp * bDirection(1)
btmp = bSize
If GetAsyncKeyState(vbKeyLeft) <> 0 Then btmp = bSize / sizeDef
If GetAsyncKeyState(vbKeyRight) <> 0 Then btmp = bSize * sizeDef
If btmp > 50 Or btmp < 3 Then btmp = bSize
bSize = btmp

'//移動
For i = 0 To 1
　　bPosition(i) = bPosition(i) + bDirection(i)
　　If bPosition(i) < bAreaMin(i) + bSize / 2 Then
　　　　bPosition(i) = 2 * bAreaMin(i) + bSize - bPosition(i)
　　　　bDirection(i) = -bDirection(i)
　　ElseIf bPosition(i) > bAreaMax(i) - bSize / 2 Then
　　　　bPosition(i) = 2 * bAreaMax(i) - bSize - bPosition(i)
　　　　bDirection(i) = -bDirection(i)
　　End If
Next i
ball.Left = bPosition(0) - bSize / 2: ball.Width = bSize
ball.Top = bPosition(1) - bSize / 2: ball.Height = bSize
Application.ScreenUpdating = True

Loop While endFlag = 1
End Sub

お礼

すごいです！
VBA得意分野と言っていいでしょうにー
ありがとうございます！＞＜

回答No.2

_Kyle

私も別に得意というわけではないですが…。

元のアプローチをなるべく生かしたつもりですが、
あまり原型が残っていませんね(^^;;

'===============↓　ココカラ　↓===============
Declare Function GetTickCount Lib "kernel32" () As Long
'----------------
Sub Sample()
　Dim X As Long, VX As Long
　Dim Y As Long, VY As Long
　Dim hyouji　As String
　hyouji = "●"
　X = 1: VX = 1
　Y = 1: VY = 1
　Do
　　Cells(X, Y).Value = hyouji
　　Call WaitSub(50)
　　Cells(X, Y).Value = ""
　　Call WaitSub(10)
　　X = X + VX
　　Y = Y + VY
　　If X = 1 Or X = 20 Then VX = VX * -1
　　If Y = 1 Or Y = 30 Then VY = VY * -1
　Loop
End Sub
'----------------
Private Sub WaitSub(ByVal mSec As Long)
　Dim Tmr As Long
　Tmr = GetTickCount() + mSec
　Do: Loop While GetTickCount() < Tmr
End Sub
'===============↑　ココマデ　↑===============

※「方向」は縦横それぞれ別個に考える必要があります。

※「右向き」・「下向き」を1、「左向き」・「上向き」を-1で表せば、
　そのまま座標に加算することで次の座標が得られますし、
　-1を掛けるだけで反転できます。

※ループでウェイトをかけると環境によって結果が違ってくるので、
　#1さんがおっしゃるとおり、時間を測った方が確実です。

※何度も同じ処理を書くようなら、
　別のプロシージャに分けた方が取り回しが良くなります。

以上ご参考まで。

お礼

うおおお!
天才がここに。
ありがとうございます!＞＜
試してみます

回答No.1

fujillin

＞これ以外のプログラムがあれば教えて欲しいです。

方法は同じですが、実現の手段としてもう少しよさそうな方法を。
考え方のみですが…（VBA得意じゃないし…）

セルに文字（●）を表示するよりも、オートシェイプの丸などを移動させる方が滑らかに移動できるし、移動の方向も、より自由に制御できる。

また、移動速度を設定する変数を用意しておいて、時間を計って移動させるようにしておくと速度も制御しやすくなる。
詳細な時間を取得するには、GetTickCountとかtimeGetTimeを利用するとよいかも…
＜参考＞
http://www.happy2-island.com/excelsmile/smile04/capter00304.shtml

お礼

お早い回答ありがとうございます!!!
参考にさせて頂きます！(∵)