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

図形を移動させている間でも、セルの入力を受け付ける方法

投稿者 : urourojiisan     投稿日時 : 2025/12/02(Tue) 07:30:03     OS : Windows 11     EXCEL : Excel 2019

Vbaの練習がてらに、掛け算の九九を作ってみました。
簡単に思って、とりかかってみたら意外と難しく
壁に突き当たってしまいました。
図形の中に掛け算の九九の問題を書き、これを100枚作りました
図形番号=問題としました。例えば図形番号82番なら
掛け算の九九の問題は 8×2= としました。

掛け算の九九の問題が、不特定の場所から図形として出現して
対角の方向へと流れていくようにしました。
図が消えるまでに入力を受け付けるようにしようとしたのですが

全くうまくいかず、とりあえず図形の移動が終わってから
入力するようにしました。 しかし
答えがわかったら、すぐに入力したくなるのが通常です。
ですのでこの Vba は、失敗作です。 

今のところ
図形の移動が終わってから、答えを入力すると問題ないのですが

大きな問題点として
図形が移動中に、セルの入力が入るとVbaが停止してしまいます。

ご指導 よろしくお願い致します。

スポンサーリンク
[返信 1] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : tkit     投稿日時 : 2025/12/02(Tue) 12:07:31
Loop+Waitを使うと思うようにならないですよ。ずっと動作してるので。
OnTimeを使う方法がいいかと。

Sub Sample()
    Dim shp As Shape
    Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, Range("A1").Left, Range("A1").Top, 80, 40)
    With shp
        .Name = "82"
        With .TextFrame2
            .HorizontalAnchor = msoAnchorCenter
            .VerticalAnchor = msoAnchorMiddle
            .TextRange.Font.Size = 18
            .TextRange.Text = "8×2"
        End With
    End With
    Application.OnTime Now + TimeValue("00:00:02"), "'OvalOnTime """ & shp.Name & """'"
End Sub

Private Sub OvalOnTime(ByVal ovalName As String)
    With Sheet1.Shapes(ovalName)
        .Left = .TopLeftCell.Offset(1, 1).Left
        .Top = .TopLeftCell.Offset(1, 1).Top
        If Application.Intersect(ActiveWindow.VisibleRange, .TopLeftCell) Is Nothing Then
            Debug.Print "STOP " & ovalName
            Exit Sub
        End If
    End With
    Application.OnTime Now + TimeValue("00:00:01"), "'OvalOnTime """ & ovalName & """'"
End Sub

[返信 2] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : 無理     投稿日時 : 2025/12/02(Tue) 18:50:43
セル編集中は、マクロは動かない

[返信 3] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : urourojiisan     投稿日時 : 2025/12/02(Tue) 20:04:25
■[返信 1] tkitさん(2025-12-02 12:07:31)の記事
> Loop+Waitを使うと思うようにならないですよ。ずっと動作してるので。
> OnTimeを使う方法がいいかと。

tkit さん
お昼休みにもかかわらず、お忙しいところを
丁寧に対応して戴き
どうもありがとうございました。

私の知識は低く、提示して戴いたコードを
応用出来る程のものは、持ち合わせておりません。

すみませんが
私のコードの中に記述して戴けますと
有難く思います。
どうぞよろしくお願い致します。

[返信 4] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : tkit     投稿日時 : 2025/12/03(Wed) 11:40:06
既に解決済みになっていますか。

> Vbaの練習がてらに、掛け算の九九を作ってみました。

> 私の知識は低く、提示して戴いたコードを
> 応用出来る程のものは、持ち合わせておりません。

⇒学ぼうとしている状況なら、当然ですよね。

> すみませんが
> 私のコードの中に記述して戴けますと
> 有難く思います。

⇒嫌です。
まるっと作り直しだからです。

九九の回答をShapeObjectの移動を停止することなく実現しようとすると、
移動はOnTimeで行い、回答はUserFormをモーダレスで表示しTextBoxで
入力値を取得する方法が思いつきました。
それで、移動のサンプルを提示しました。

触られました?


[返信 5] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : urourojiisan     投稿日時 : 2025/12/03(Wed) 13:29:09
■[返信 4] tkitさん(2025-12-03 11:40:06)の記事
> 既に解決済みになっていますが?
掲示板の使用方法をよくわかっていなくて
ボタンを押し間違えたと思います。
すみませんが、解決済みではありません。

なのに
書き込みをして戴きありがとうございます。


> 触られました?

はい OnTime について勉強させていただこうと、頑張ってみました。
図の表示方法など、ひとつづつ丁寧に調べながら見させていただきました。
F8を使って、順に送っていきました。

ただ残念ながら最後の行だけはエクセルが動かなくなって
その先へは理解を進めることが出来ませんでした。
せっかく教えて戴いたのに
その点を申し上げるのは、さすがに苦しくて言えませんでした。

プロパティのどこかを変更したら動くのでは?
と探ってみましたが、残念ながら見つけることは出来ませんでした。
それで、私のコードの中に どのように入り込ませるのかを
知りたくて、コードの提示をお願いをしてみました。

せっかく教えてくれた人に 嫌な思いをさせて、どうもすみませんでした。
これに懲りず、どうか今後ともご指導のほどよろしくお願い致します。

[返信 6] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : tkit     投稿日時 : 2025/12/04(Thu) 08:44:13
説明不足でしたね。
標準モジュールに提示の2つのSubプロシージャを貼り付けてください。
SampleプロシージャでF5キーで実行してください。

ShapeObjectが左上に作成され、1秒おきに、右下へ移動するはずです。
画面外になったら止まり、イミディエイトウィンドウにコメントが出ます。


Sampleプロシージャ
ShapeObject作成

現在時刻から2秒後に、OvalOnTimeプロシージャ実行予約


OvalOnTimeプロシージャ
引数の文字列名のShapeObject取得
1行1列シフトしたセルのTopLeft値へ移動
画面外になったら終了
現在時刻から1秒後に、OvalOnTimeプロシージャ実行予約

[返信 7] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : urourojiisan     投稿日時 : 2025/12/05(Fri) 06:25:57
■[返信 6] tkitさん(2025-12-04 08:44:13)の記事

お忙しいところを
私のために時間を割いて戴きすみません。
丁寧な説明をありがとうございます。

やっと解決への糸口らしいものが見えかけました。
提示して戴いたコードが動かなかった理由は
私のノートパソコンが古くてバージョン?というのでしょうか
Excel2019には提示して戴いたコードを受け入れることが出来なかった。

ということが一番あやしいので、もしよろしかったら
すみませんが、提示して戴いた内容の最後の一行だけ
Excel2019でも動くようなコードで
ご指導お願いできませんでしょうか。

提示して戴いた案ですが、これは、かなり魅力的ですので
ぜひ、前に向けて進めていきたいと思っています。
OnTimeさえ動けば、自力で何とかなりそうですので
どうぞよろしく、お願い致します。

[返信 8] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : tkit     投稿日時 : 2025/12/05(Fri) 08:57:53
すいません。

Private Sub OvalOnTime(ByVal ovalName As String)



Sub OvalOnTime(ByVal ovalName As String)

に変更してください。

また、当方では1秒設定でも、途中5秒間隔に遅延する現象が見えました。
原因はExcel側なので、分かりません。
表計算ソフトなので、仕方がありませんね。

[返信 9] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : urourojiisan     投稿日時 : 2025/12/06(Sat) 08:49:05
■[返信 8] tkitさん(2025-12-05 08:57:53)の記事
お忙しい中をありがとうございます。
ちゃんと動きました。これでなんとかなりそうです。
私のパソコンでも動くように書き換えて下さって
丁寧な対応に感謝いたします。

動きましたね。
うれしくって何度も何度も感動しながら動かしました。

それにしても
ひさしぶりにでくわしましたね。

> ⇒嫌です。

気持ちのいい言葉でした。
こんなにはっきりと言ってくれる人はそう簡単にはいませんね。

こんな人は、おもいっきり信用出来ます。

私は Vba は簡単な部分しかわかっていません。
Vba の扉を開けて中へと3歩から10歩くらい入ったところかな
10万歩以上あるというのに。
ですので今は、すべてコメントを書くクセをつけています。

OnTime の機能について私が理解を間違っていたら
後々間違った方向へと行って行き詰るので
コメントを書いています。

すみませんが
間違った理解をしていないか添削お願い致します。


Sub Test1()
    Dim shp As Shape        'shpをShape型と宣言します。
'shpに以下をセットします。図形No9番の楕円形をLeft、Top共A1の位置にサイズ巾80高さ40のものを表示しなさい。
    Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, Range("A1").Left, Range("A1").Top, 80, 40)
    With shp
        .Name = "82"                                '82ハニーちゃんという、お名前をつけてあげました。
        With .TextFrame2                            '自由自在に設定出来るこの道具を使って以下を設定
            .HorizontalAnchor = msoAnchorCenter     '横の位置は中央
            .VerticalAnchor = msoAnchorMiddle       '縦の位置は中央
            .TextRange.Font.Size = 18               'テキストの文字サイズは18ポイント
            .TextRange.Text = "8×2"                'テキストは名前と同じ掛け算の九九を記入しました。
        End With
    End With
'以下は OnTime の機能だと思いますが、初めてなのではっきりとわかっていませんが・・・
'設定している5秒後に、ファイル名 OvalOnTime へ shp.Name の値を持って行って仕事をしてきなさい  かな?
    Application.OnTime Now + TimeValue("00:00:05"), "'OvalOnTime """ & shp.Name & """'"
End Sub


Sub OvalOnTime(ByVal ovalName As String)        '値渡しの82は数値みたいだけど名前扱いなので宣言はString
    With Sheet1.Shapes(ovalName)                'シート1の82図形で、下のことをしなさい
        .Left = .TopLeftCell.Offset(1, 1).Left  'Leftは右と下へそれぞれセル1つ分ズラしなさい
        .Top = .TopLeftCell.Offset(1, 1).Top    'Topは右と下へそれぞれセル1つ分ズラしなさい
        If Application.Intersect(ActiveWindow.VisibleRange, .TopLeftCell) Is Nothing Then
            Debug.Print "STOP " & ovalName      'もし、ウィンドウの端っこをキャッチしたならばStopしなさい
            Exit Sub                            '脱出しなさい
        End If
    End With
'下ははっきりとわかっていません。が 1秒間隔で82ハニーちゃんを画面の外まで移動させなさい
    Application.OnTime Now + TimeValue("00:00:01"), "'OvalOnTime """ & ovalName & """'"
End Sub

[返信 10] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : ピロリ     投稿日時 : 2025/12/08(Mon) 07:36:04
横から失礼します。

下のサンプルは Sleep関数を使ってみました。 大分「OnTime」で話が進んでるようなので今更でしょうけど。
でも、ユーザーフォームで値を入力させるってところは参考になるかも・・・ 多分・・・

ユーザーフォーム( UserForm1に TextBox1を配置するだけ )は、ご自分で作成して下さい。
ちなみに、私の環境では DoEventsが1回だと上手く表示更新しない場合があったので、2回ずつにしてます。

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long) 'Sleep関数(32bit)の使用宣言

Sub Multiplication()
    Dim 被乗数 As Long, 乗数 As Long, 積 As Long, レベル As Long, 正解数 As Long
    Dim shp As Shape, i As Long, j As Long, k As Long
    
    レベル = Val(InputBox("1:初級, 2:中級, 3:上級", "レベルの入力", "1"))
    If レベル < 1 Or 3 < レベル Then Exit Sub                   '1~3の入力以外は終了
    
    Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, _
                    Range("A1").Left, Range("A1").Top, 80, 40)  '図形(楕円)の作成
    shp.TextFrame2.HorizontalAnchor = msoAnchorCenter           '横の位置は中央揃い
    shp.TextFrame2.VerticalAnchor = msoAnchorMiddle             '縦の位置は中央揃い
    shp.TextFrame2.TextRange.Font.Size = 18                     '文字サイズは18Pt
    正解数 = 0
    UserForm1.Show vbModeless                                   'ユーザフォームの表示
    For i = 1 To 5                                              '問題は5問を出題
        '問題の作成 --------
        被乗数 = WorksheetFunction.RandBetween(1, 9)            '乱数(1~9)を被乗数へ
        乗数 = WorksheetFunction.RandBetween(1, 9)              '乱数(1~9)を乗数へ
        積 = 被乗数 * 乗数
        shp.TextFrame2.TextRange.Text = 被乗数 & "×" & 乗数    '問題の表示
        UserForm1.TextBox1 = ""                                 'TextBoxを消去
        UserForm1.TextBox1.SetFocus                             'TextBoxをフォーカス
        '図形の移動 --------
        For j = 1 To 12 Step レベル                             'レベル毎のループ
            shp.Left = Cells(i, j).Left                         '図形の移動(横方向)
            shp.Top = Cells(i, j).Top                           '図形の移動(縦方向)
            For k = 1 To 10                         '小刻みに DoEventsした方が良い
                DoEvents: DoEvents: Sleep (100)     '(左の場合、100ミリ秒×10回)
            Next k
            '答え合わせ --------
            If Val(UserForm1.TextBox1) = 積 Then                '正解ならば、
                shp.TextFrame2.TextRange.Text = "正解"          '図形へ「正解」を表示
                DoEvents: DoEvents: Sleep (500)                 '500ミリ秒の停止
                正解数 = 正解数 + 1                             '正解数を更新(+1回)
                Exit For                                        '次の問題へ
            End If
        Next j
    Next i
    shp.Delete                                                  '図形の消去
    Unload UserForm1                                            'ユーザフォームの消去
    DoEvents: DoEvents
    '成績発表 --------
    MsgBox "正解:" & 正解数 & "回です"                         '正解数を表示
End Sub

[返信 11] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : tkit     投稿日時 : 2025/12/08(Mon) 10:43:20
コメントを拝見しました。
修正するのであれば以下の点です。

> 'もし、ウィンドウの端っこをキャッチしたならばStopしなさい
⇒ '82図形が配置している左上セルが、アクティブウィンドウに表示しているセル範囲の外側ならば、・・・


私が出した案が全てではないので、ピロリさんのコードも動作し確認してくださいね。


私の案は、イベントで動作させる仕様です。

UserForm1を作成してください。TextBox1を配置するだけで結構です。

'--UserForm1--
Option Explicit

Sub ShowAnswer(ByVal expr As String)
    If Me.Visible Then Exit Sub '既に表示済なら終了
    Load Me
    Me.Caption = expr
    Me.Show vbModeless
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    ' 数字キー、テンキーの0~9、Enter、BackSpace、Deleteのみ有効
    Select Case KeyCode
        Case vbKey0 To vbKey9
        Case vbKeyNumpad0 To vbKeyNumpad9
        Case vbKeyBack
        Case vbKeyDelete
        Case vbKeyReturn
            ThisWorkbook.Worksheets("AnsSheet").Range("A1").Value = TextBox1.Value
            Unload Me
        Case Else
            KeyCode = 0
    End Select
End Sub

続いて、
図形にクリックイベントを紐づけます。

Sub Test1()
    Dim shp As Shape
    Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, Range("A1").Left, Range("A1").Top, 80, 40)
    With shp
        With .TextFrame2 
        End With
        .OnAction = "'OvalClick """ & .TextFrame2.TextRange.Text & """'"  '追加
    End With
    Application.OnTime Now + TimeValue("00:00:05"), "'OvalOnTime """ & shp.Name & """'"
End Sub

標準モジュールに追加↓
Sub OvalClick(ByVal expr As String)
    UserForm1.ShowAnswer expr
End Sub

Sub CatchAnswer(ByVal ans As Long)
    '答えを受け取る
    Debug.Print ans
End Sub

マクロブックにワークシート"AnsSheet"を追加し非表示にする。
ワークシート"AnsSheet"に以下コードを追加
'--AnsSheet--
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Me.Range("A1"), Target) Is Nothing Then Exit Sub
    CatchAnswer Target.Value
End Sub

[返信 12] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : ピロリ     投稿日時 : 2025/12/08(Mon) 13:25:05
■[返信 11] tkitさん(2025-12-08 10:43:20)の記事
Private Sub TextBox1_KeyDown()
確かに、[Enter]キーで入力データの確定をした方が良心的ですね。 勉強になります。

また、[返信 10]で提示したコードのjループは、12までではなく 13までが正しいです。
どのレベル(1~3)でも、M列までは図形移動させるということで・・・ 大変失礼しました。
 For j = 1 To 12 Step レベル
        ↓
 For j = 1 To 13 Step レベル

[返信 13] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : urourojiisan     投稿日時 : 2025/12/09(Tue) 08:46:33
ピロリさん
横やりだなんて、とんでもないです。
私が寒そうだったので、暖かい毛布を差し出してくれた
とても心のあったかい方です。

私のために、わかりやすい方法と表記で書いて戴き
ありがとうございました。

私のノートパソコンには自分の手で64bitと書いてあります。
ずっと前なので、いつ頃書いたものか覚えていません。
それでずっとエクセルも64bitだと思い込んでいました。

コードの最初に32bit用に、と書いてくれていましたので
これは用がないな、と勝手に思って
先頭にShift+7 ' を付けて止めておこうかなと思いましたが

念のために確認してみました。
ネットを調べると確認方法が載っていました。
ファイル→その他→アカウント→バージョン情報
なんと なんと 32bit でした。確認してよかったぁ。

これはありがたい大きな収穫でした。
今後失敗して行き詰まる、大きなつまづきを防いでくれました。
どうもありがとうございました。

ついでに念のためにネットから調べてみました。
ウインドウズマークを右クリックしてシステム押したら出ました。
64ビットオペレーティングシステム×64ベースプロセッサ
と出ていました。

なんで? エクセルも64bitに、と同じようにしてないのかな?
あぶないところでした。

何度も問題に回答しているうちに気が付きました。
アレッ
Enter が要らないような Enter 押さなくても効いていました。

私のために、長い時間をかけて作ってくれたものだから
見るだけでは、ピロリさんに失礼に当たりますね。

コードをコピぺじゃなくて手書きで書き写し

私のような初心者には、これをやると効果てきめんです。

時間がかかるけど、知らないコードはその場で調べて進めています。

問題が移動するとき、ユーザーフォームの陰で見えない時がある。
ユーザーフォームを逃がせないだろうか。見つけました。
UserForm1.StartUpPosition = 0 : UserForm1.Left = 1150
これで、きわどく画面右端かすかに見えるかなという位置です。

正解数 = 0 ん ダブルループの外に置いている?
私はループの中にしか入れたことがなかったので新鮮でした。
同じプログラムの中なので 正解数 = 3 とか動いてくれますね。

私は100枚のTextBoxにひとつづつ、ご丁寧に九九の問題を書いていました。
答えを出すコードに一苦労も二苦労もしました。
TextFrame2.TextRange.Text = 被乗数 & "×" & 乗数
変数を入れて問題を作るなんて、全く思い付きませんでした。

>ユーザーフォームで値を入力させるってところは参考になるかも・・・ 多分・・・
多分・・・ どころではありませんでしたね。
InputBoxでダメだったのであきらめかけていました。

tkitさんがすぐに反応してくれて、ヒントを戴きました。

OnTime は初めてでしたのでいろいろと探っていました。
OnTime の類似コードを、勉強不足のまま動かしてみたりしたので
何度も無限ループにやられながら成長しました。

この度は、私のために長い時間を費やして
コードを書いて戴きましてありがとうございました。
大変感謝しています。

私の今の能力?脳力では tkitさんへの
返信がかなり遅れそうです。
tkitさんすみません。

[返信 14] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : urourojiisan     投稿日時 : 2025/12/09(Tue) 19:02:37
お忙しいところすみませんがお尋ねします。
8×2は現れて画面の外まで行きますが
私のやり方と、組み込み方がわかってないのであと動きません。

現在までに私がやったこと
ワークシートには、Sheet1しかありません。
Sheet1のシート名の部分を右クリックして再表示を押すと
AnsSheet が現れます。
現れたシートを右クリックしてコードの表示を押すと下の部分が現れます。

'--AnsSheet--
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Me.Range("A1"), Target) Is Nothing Then Exit Sub
    CatchAnswer Target.Value
End Sub

これは閉じて AnsSheet は非表示にしておきます。

次に
Alt+F8 で Test1 編集を押すと下のコードが現れます。
左の端は標準モジュールですぐ下は Module1 となっています。

そのすぐ上はフォームで UserForm1 となっています。
すみませんが、ご指導お願い致します。

'--UserForm1--
Option Explicit
Sub ShowAnswer(ByVal expr As String)
    If Me.Visible Then Exit Sub '既に表示済なら終了
    Load Me
    Me.Caption = expr
    Me.Show vbModeless
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    ' 数字キー、テンキーの0~9、Enter、BackSpace、Deleteのみ有効
    Select Case KeyCode
        Case vbKey0 To vbKey9
        Case vbKeyNumpad0 To vbKeyNumpad9
        Case vbKeyBack
        Case vbKeyDelete
        Case vbKeyReturn
            ThisWorkbook.Worksheets("AnsSheet").Range("A1").Value = TextBox1.Value
            Unload Me
        Case Else
            KeyCode = 0
    End Select
End Sub

Sub Test1()
    Dim shp As Shape        'shpをShape型と宣言します。
'shpに以下をセットします。図形No9番の楕円形をLeft、Top共A1の位置にサイズ巾80高さ40のものを表示しなさい。
    Set shp = Sheet1.Shapes.AddShape(msoShapeOval, Range("A1").Left, Range("A1").Top, 80, 40)
    With shp
        .Name = "82"                                '82ハニーちゃんという、お名前をつけてあげました。
        With .TextFrame2                            '自由自在に設定出来るこの道具を使って以下を設定
            .HorizontalAnchor = msoAnchorCenter     '横の位置は中央
            .VerticalAnchor = msoAnchorMiddle       '縦の位置は中央
            .TextRange.Font.Size = 18               'テキストの文字サイズは18ポイント
            .TextRange.Text = "8×2"                'テキストは名前と同じ掛け算の九九を記入しました。
        End With
    .OnAction = "'OvalClick """ & .TextFrame2.TextRange.Text & """'"  '追加
    End With
'以下は OnTime の機能だと思いますが、初めてなのではっきりとわかっていませんが・・・
'設定している5秒後に、ファイル名 OvalOnTime へ shp.Name の値を持って行って仕事をしてきなさい  かな?
    Application.OnTime Now + TimeValue("00:00:05"), "'OvalOnTime """ & shp.Name & """'"

 '   UserForm1.Show vbModeless
End Sub
    '標準モジュールに追加↓
Sub OvalClick(ByVal expr As String)
    UserForm1.ShowAnswer expr
End Sub
    
Sub OvalOnTime(ByVal ovalName As String)        '値渡しの82は数値みたいだけど名前扱いなので宣言はString
    With ActiveSheet.Shapes(ovalName)                'シート1の82図形で、下のことをしなさい
        .Left = .TopLeftCell.Offset(1, 1).Left  'Leftは右と下へそれぞれセル1つ分ズラしなさい
        .Top = .TopLeftCell.Offset(1, 1).Top    'Topは右と下へそれぞれセル1つ分ズラしなさい
        If Application.Intersect(ActiveWindow.VisibleRange, .TopLeftCell) Is Nothing Then
            Debug.Print "STOP " & ovalName      'もし、ウィンドウの端っこをキャッチしたならばStopしなさい
            Exit Sub                            '脱出しなさい
        End If
    End With
'下ははっきりとわかっていません。が 1秒間隔で82ハニーちゃんを画面の外まで移動させなさい
    Application.OnTime Now + TimeValue("00:00:01"), "'OvalOnTime """ & ovalName & """'"
End Sub

Sub CatchAnswer(ByVal ans As Long)
    '答えを受け取る
    Debug.Print ans
End Sub

[返信 15] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : tkit     投稿日時 : 2025/12/10(Wed) 13:03:58
提示のコードで、こちらは動作します。

概要を解説します。

Sub Test1 実行 ⇒ Shape表示 & Sub OvalOnTime で移動 ⇒ Shapeクリック ⇒ Sub OvalClick イベント実行 ⇒
UserForm1 Sub ShowAnswer起動でモーダレス表示 ⇒ UserForm1のTextBox1に答え入力+Enterキー ⇒
Private Sub TextBox1_KeyDownイベント実行からAnsSheetのA1に答え入力 UserForm1終了 ⇒
AnsSheetのPrivate Sub Worksheet_Change イベント実行 ⇒ Sub CatchAnswer起動 ⇒
イミディエイトウィンドウにUserForm1に入力した答えを表示

コードを貼り付け箇所を間違っているとか?

標準で存在するイベントを組み合わせていますので、複雑になりますね。
私も全てにお付き合い出来ないので、どのように処理するかは、ご自身で検討ください。
アドバイスは出来ますけどね。

[返信 16] Re : 図形を移動させている間でも、セルの入力を受け付ける方法
投稿者 : urourojiisan     投稿日時 : 2025/12/10(Wed) 15:52:37
tkitさん
すみませんでした。
楕円形クリックするのに気が付きませんでした。
' OvalClick(ByVal expr As String)
'UserForm1.ShowAnswer expr


それから添削をありがとうございました。
自分でも画面の外よりも、もうひとつ外だな なんでかな とずっと思っていました。
82図形が配置している左上セルが、アクティブウィンドウに表示しているセル範囲の外側ならば、・・・
だからもう一つ外だったのかと理解出来ました。わかりやすい丁寧な説明ありがとうございました。

それに楽しいゲームになりそうです。
マウスで コラッ 待て! ってつかまえるのは私のような爺さんでもおもしろいですね。
お忙しい中を私のために貴重な時間をさいていただきましてどうもありがとうございました。

ピロリさん tkitさん
この度は私の全く知らなかったコードなど、また思いもつかないような斬新な
アイディアも教えてもらいましていろいろと勉強をさせていただきました。
どうもありがとうございました。

解決済みです。

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

ステータス  :

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




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