ユーザーフォームを複数起動してゲーム作成【ExcelVBA】

ユーザーフォームを複数表示する為に、Newキーワードを使用して新規オブジェクトを生成する

そしてその変数名で使用する形で同時に複数起動していく

ユーザーフォームを纏めてメモリから解放する為に、TerminateイベントにUnloadステートメントを入れる

Terminateイベントはユーザーフォームが閉じられた時に起動されるプロシージャ

ユーザーフォームをクリックしたら上に戻す形をとるので、WinAPIのSleepではなくGetTickCountの機能を使用する

GetTickCount　「時間を取得」

宣言文：Declare PtrSafe Function GetTickCount Lib “kernel32” () As Long

使用方法：GetTickCount　→　Windows起動後の経過時間をミリ秒単位で取得

例：let 変数 = GetTickCount　→　変数に起動後の時間を代入する

こちらで指定した秒数待機してその間LoopしているのでDoEvents関数でOSに制御を渡す

それでその間操作することが可能になる

UserFormをClickすることでユーザーフォームを初期の位置に戻す

Topは上端の位置、Leftは左端の位置

ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ

実際に使用したサンプルコード

'標準モジュール内

Option Explicit
'Windows起動後の時間をミリ秒単位で取得
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Public ユーザーフォーム1 As New UserForm1
Public ユーザーフォーム2 As New UserForm1
Public ユーザーフォーム3 As New UserForm1
Public ユーザーフォーム4 As New UserForm1
Public ユーザーフォーム5 As New UserForm1
Public ユーザーフォーム設定 As New UserForm2
Public ユーザーフォームロボ太 As New UserForm3
Dim 開始時間 As Long
Public 点数 As Long
Dim コレクション As New Collection
Public Sub Main()

Application.Visible = False

点数 = 0

コレクション.Add ユーザーフォーム1
コレクション.Add ユーザーフォーム2
コレクション.Add ユーザーフォーム3
コレクション.Add ユーザーフォーム4
コレクション.Add ユーザーフォーム5

Dim フォーム As UserForm1

For Each フォーム In コレクション
フォーム.Show vbModeless
Next

ユーザーフォームロボ太.Show vbModeless
ユーザーフォームロボ太.Left = 0
ユーザーフォームロボ太.Top = 400
ユーザーフォーム設定.Show vbModeless
ユーザーフォーム設定.Left = 700
ユーザーフォーム設定.Top = 0

Dim 左の位置 As Long
左の位置 = 0

For Each フォーム In コレクション
フォーム.Left = 左の位置
フォーム.Top = 0
左の位置 = 左の位置 + 150
Next

'無限ループ
Do

'指定した秒数待機
開始時間 = GetTickCount

'指定した秒数待機
Do While GetTickCount - 開始時間 < ユーザーフォーム設定.ScrollBar1.Value * 100
DoEvents
Loop

For Each フォーム In コレクション
フォーム.Top = フォーム.Top + 10
If フォーム.Top > ユーザーフォームロボ太.Top - フォーム.Height Then
MsgBox "GAMEOVER" & 点数 & "点でした"
Application.Visible = True
End
End If
Next

Loop

End Sub

’ユーザーフォーム側

Option Explicit
'フォームをクリックしたときに起動される
Private Sub UserForm_Click()

Me.Top = 0
Me.Left = Application.WorksheetFunction.RandBetween(0, 500)
点数 = 点数 + 1

End Sub

'フォームが起動される時に発生
Private Sub UserForm_Initialize()

Me.Width = 100
Me.Height = 100

End Sub
'フォームが閉じられた時に起動する
Private Sub UserForm_Terminate()

Unload ユーザーフォーム1
Unload ユーザーフォーム2
Unload ユーザーフォーム3
Unload ユーザーフォーム4
Unload ユーザーフォーム5
Unload ユーザーフォーム設定
Unload ユーザーフォームロボ太
Application.Visible = True

End

End Sub

’ユーザーフォーム2個目設定用

Option Explicit
Private Sub CommandButton1_Click()

Unload ユーザーフォーム1
Unload ユーザーフォーム2
Unload ユーザーフォーム3
Unload ユーザーフォーム4
Unload ユーザーフォーム5
Unload ユーザーフォーム設定
Unload ユーザーフォームロボ太

End

End Sub
'スクロールバーが変化があった時に起動
Private Sub ScrollBar1_Change()

Label1.Caption = ScrollBar1.Value

End Sub
Private Sub UserForm_Initialize()

Label1.Caption = ScrollBar1.Value

End Sub
Private Sub UserForm_Terminate()

Unload ユーザーフォーム1
Unload ユーザーフォーム2
Unload ユーザーフォーム3
Unload ユーザーフォーム4
Unload ユーザーフォーム5
Unload ユーザーフォーム設定
Unload ユーザーフォームロボ太
Application.Visible = True

End

End Sub

’ユーザーフォーム3つ目　

Option Explicit
Private Sub UserForm_Initialize()

Me.Width = 1500
Me.Height = 100
Image1.Width = 1500
Image1.Height = 100
End Sub

Private Sub UserForm_Terminate()
Unload ユーザーフォーム1
Unload ユーザーフォーム2
Unload ユーザーフォーム3
Unload ユーザーフォーム4
Unload ユーザーフォーム5
Unload ユーザーフォーム設定
Unload ユーザーフォームロボ太
Application.Visible = True

End
End Sub