Excel VBA 質問スレッド №2158 (解決済)

コードの入力を忘れました

投稿者 : urourojiisan     投稿日時 : 2025/12/02(Tue) 07:34:48     OS : Windows 11     EXCEL : Excel 2019
大変失礼いたしました。
5分前に質問のお願いをしてコードの入力を忘れました。

'Option Explicit
Private Sub WaitSec(ByVal sec As Single)
Dim t As Single
t = Timer
Do While Timer - t < sec
DoEvents    ' 他の処理を許可
Loop
End Sub

Sub スタート()
 Dim 進捗 As Long   '100札のループ用
Dim 札番号 As Long  '出題番号
Dim 移動 As Long    '出題番号の札を出した時に動かすアニメーション
Dim 縦移動 As Long, 横移動 As Long
Dim shp As Shape
'このゲームではEnter のあとにカーソルが動いたら困るので動かないようにした
Application.MoveAfterReturn = False

'ThisWorkbook.Sheets("掛け算の九九").Shapes("楕円 101").Left = 1500    'スタートボタン 実行直後に移動
 Cells(1, 11).Select    '確認中に画面がズレていることがあるので       上のは  完成したら ' を外す

'乱数 'I列に乱数設定 完成したら ' を外す


'レベルを決めてもらう
Cells(3, 3) = "レベルは、どこにする 1 2 3 → → →"
If Cells(3, 6).Value = "上級" Then 速度 = 3     'Cells(3, 6)を選択したら
If Cells(3, 6).Value = "中級" Then 速度 = 2     'ドロップダウンリストが出てくるので
If Cells(3, 6).Value = "初級" Then 速度 = 1     'レベルを選べるようにした。
WaitSec 6
Cells(3, 3) = ""        '表示は、いらない ので消す

Range("F11:F111") = "": Range("H11:H111") = ""  '入力欄と判定〇×欄は、いったん消す

For 進捗 = 1 To 10          '完成したら50枚にする

Range("C3:C5") = "": Cells(1, 6) = 進捗     '今の出題番号がわかるように
札番号 = Cells(10 + 進捗, 9)                '出す札はここで決定

Set shp = ThisWorkbook.Sheets("掛け算の九九").Shapes("TextBox" & 札番号) '出す札の準備

Dim startTop As Variant, startLeft As Variant
Dim moveY As Variant, moveX As Variant
Dim 動きのパターン As Variant

Randomize
動きのパターン = WorksheetFunction.RandBetween(0, 7)         '配列を採用するので ゼロから7 にしないと。

'--- 始点の設定(Top, Left) ---
startTop = Array(0, 250, 500, 500, 500, 250, 0, 0)      '縦初期位置
startLeft = Array(0, 0, 0, 500, 1000, 1000, 1200, 500)    '横初期位置

'--- 移動方向(縦と横の進む向き) ---
moveY = Array(1, 0, -1, -1, -1, 0, 1, 1)   '縦方向(下:+、上:-)    長方形画面なので、正方形画面のように
moveX = Array(2.5, 1.5, 2, 0, -2, -1, -2.5, 0)   '横方向(右:+、左:-)縦横比が1対1とは しなかった

'--- 実行 ---
For 移動 = 1 To 1200 Step 速度 * 20
    shp.Top = startTop(動きのパターン) + 移動 * moveY(動きのパターン)
    shp.Left = startLeft(動きのパターン) + 移動 * moveX(動きのパターン)
    If shp.Top < 10 Or shp.Left < 10 Then shp.Left = 1500
    WaitSec 0.1
    
    '少しでも早くアニメを停止 終わりにしたい  考え方はよいが、画面の 数値 が 少しズレている
    '問題が解決したら これはイラン。
    If shp.Top > 500 And shp.Left > 1100 Then Exit For
    
    
  '  DoEvents
    
'これは言うことを効いてくれなかった。  やりかたが悪るかったのかな
'    If Len(Cells(5, 3).Value) > 0 And IsNumeric(Cells(5, 3).Value) Then
'                Call 判定
'                Exit For
'            End If

    
    
Next 移動

Cells(4, 3) = "答えを入れて下さい"        '答えを入れるタイミングをみるために  完成したらイラン
Cells(5, 3).Select  '答えを書くセルの位置

        Do While Len(Cells(5, 3).Value) = 0 Or Not IsNumeric(Cells(5, 3).Value)     ' 入力待ち
            DoEvents
        Loop
        
If 札番号 < 11 Then
正答 = 0
Else
正答 = Int(札番号 / 10) * (札番号 Mod 10)
End If

'Dim userName As String         'InputBoxを使ってもダメだった
'    ansa = InputBox("答えを入力してください")
'     Cells(5, 3) = ansa

If Cells(5, 3) = 正答 Then Cells(4, 3) = "〇": Cells(進捗 + 10, 8) = "〇": 'Stop 'うしろは記録用
If Cells(5, 3) <> 正答 Then Cells(4, 3) = "×": Cells(進捗 + 10, 8) = "×": 'Stop 'うしろは記録用

Cells(10 + 進捗, 6) = Cells(5, 3)        'あとで確認用

Call WaitSec(2) '2秒以内に入力がなければ タイムアウトで次へ進みなさい


'ここで札を定位置に戻し
If 札番号 Mod 10 = 0 Then   '横方向の定位置戻し
shp.Left = 4368
Else
shp.Left = 168 * (25 + (札番号 Mod 10) + 1)
End If

 If 札番号 < 10 Then     '縦方向の定位置戻し
shp.Top = 0
Else
shp.Top = Int(札番号 / 10) * 60
 End If
 

 Next 進捗      '1ループ終了
 
'このゲームではEnter のあとにカーソルが動いたら困るので動かないようにしたのを戻した。
Application.MoveAfterReturn = 1
Application.MoveAfterReturnDirection = xlDown

ThisWorkbook.Sheets("掛け算の九九").Shapes("四角形: 角を丸くする 1").Left = 700     '終ったら元の場所に戻す
If WorksheetFunction.CountIf(Range("H21:H120"), "〇") = 100 Then Cells(3, 3) = "おめでとう": Cells(4, 3) = "やったね100点だ"
If WorksheetFunction.CountIf(Range("H21:H120"), "〇") = 99 Then Cells(3, 3) = "もったいない": Cells(4, 3) = "もう少しで100点だったのにね"
If WorksheetFunction.CountIf(Range("H21:H120"), "〇") = 98 Then Cells(3, 3) = "おしい": Cells(4, 3) = "もう少しで100点だったのに"
If WorksheetFunction.CountIf(Range("H21:H120"), "〇") = 97 Then Cells(3, 3) = "もう一回いく?": Cells(4, 3) = "よく練習してるね"
End Sub

スポンサーリンク
[返信 1] Re : コードの入力を忘れました
投稿者 : urourojiisan     投稿日時 : 2025/12/02(Tue) 21:46:23
■[質問] urourojiisanさん(2025-12-02 07:34:48)の記事
> 大変失礼いたしました。
> 5分前に質問のお願いをしてコードの入力を忘れました。

すみません。

間違ってここに貼り付けてしまいました。

当掲示板について
  • Excel VBA に関する掲示板です。Excel VBA に関する質問や疑問、それに対する解決方法など気軽に投稿してください。
  • 記事内ではHTMLのタグは使用できません。
  • 記事は一度投稿すると修正できません。内容を訂正したい場合は返信で対応してください。
  • Sub〜End Sub、Function〜End Function は自動的にプログラムコードとみなし、枠で囲って見やすくします。
  • Excel VBA とは関係ないことや、他人が不快に思うようなことなど、管理人が適当でないと判断した記事は削除する場合があります。
スポンサーリンク
返信入力フォーム
お 名 前  :
内  容   :

ステータス  :

認証コード  : キャプチャ画像 




( 処理日時 : 2026-01-11 18:41:37 )
タイトルとURLをコピーしました