VBAでスロットを作る
- VBAを使用して簡単なスロットを作成する方法を教えてください。
- スロットを回転させて止めるまではできましたが、メッセージを出す段階でエラーが発生しています。
- なぜエラーが発生するのか、解決方法を教えてください。
- ベストアンサー
VBAでスロットを作る
VBAでゲームを作ろうとしています。まず、手始めに簡単なスロットを作っています。スロットを回転させて止めるまではできたのですがメッセージを出す段階でメッセージが2回、0とiの値が出ます。次のコードなのですが、なぜできないのか、どうすればできるようになるのか教えてください。よろしくお願いします。 Sub SlotLoop_1() Dim i As Long Static Flg As Boolean Flg = Not Flg 'ボタンを使えるようにする With [a1] 'Ａ１を選ぶ Do If Flg = False Then Exit Do i = (i + 1) Mod 10 '（i+1）を10で割った余り。 .Value = i DoEvents Loop End With MsgBox i 'ここが問題 End Sub
- rangeru
- お礼率83% (15/18)
- その他（プログラミング・開発）
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
これって、あるボタンを押したらFlgがTrueになって、スロットがぐるぐる回る。もう一度同じボタンを押したらFlgがFalseになって、スロットが止まってメッセージを出す、という事でしょう？ これではちょっと無理やね。フラグの状態によって分岐させんと。 > なぜできないのか まず、1個目のButton_Click()がFlgをTrueに変えてループし、ループの途中で他のメッセージを処理します。 ここで同じボタンを押すと、1個目のButton_Click()がまだ実行途中のまま2個目のButton_Click()が動き始め、FlgをFalseに変えます。そして2個目はFlgがFalseなのでそのまま(=iが0のまま)ループを1回も実行せずに抜けてMsgBoxで「0」を表示して終了します。 その後、DoEventsで2個目のButton_Click()が実行され終了されるのを待っていた1個目のButton_Click()に制御が戻り、ループしていた回数だけ変化したiの値がMsgBoxによって出てきた訳だ。 修正方法としては・・・・一番簡単なのは、 －－－－オリジナルソーススタート Flg = Not Flg 'ボタンを使えるようにする －－－－オリジナルソースエンド これを次のように変えましょう。 －－－－修正ソーススタート Flg = Not Flg 'ボタンを使えるようにする If Not Flg Then Exit Sub ' ここに来た時にFlgがFalseなら、2個目という事なのでそのまま終了 －－－－修正ソースエンド 今回はDoEventsの気をつけなければいけない使い方の例でした。
関連するQ&A
- vba boolean変数を開放する方法
エクセルのセルに「○○○○○○○○○○××××××××××」と入っているものをランダムに並べ代えるマクロを探してみました。 Sub macro2() Dim i, m As Integer Dim b, c As String Dim flg(1 To 20) As Boolean b = Cells(1, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(1, 2).Value = c End Sub これはうまく動くのですが、10行分やろうとして、以下のように変更すると暴走（終わらない）します。 Sub macro2() Dim i, m, n As Integer Dim b, c As String Dim flg(1 To 20) As Boolean For n = 1 To 10 b = Cells(n, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(n, 2).Value = c next n End Sub 一行目が終わってもboolean変数の値がそのまま残っているのが原因らしいのですが開放する方法がわかりません。 取りあえずもう一つマクロを追加してやりたいことはできたのですが、 Sub macro1() Dim n As Integer For n = 1 To 10 Call macro2(n) Next n End Sub Sub macro2(n As Variant) 以下略 なんかスッキリしません。 boolean変数を開放し、マクロひとつですます方法を教えて頂きたくお願いします。 flg(m) = Falseを挿入してもダメでした。
- ベストアンサー
- Excel（エクセル）
- 素数を求めるマクロを
走らすと暴走したようになり、素数＝１５１で止まります。 どこが悪いのでしょうか。正常に終わるようにしたいです。 ====================== Sub 素数を求める() Dim i As Long Dim j As Long Dim m As Long Dim p As Long Dim flg As Boolean i = 1 j = 1 p = 2 Do flg = False For m = 2 To Int(Sqr(p)) If p Mod m = 0 Then flg = True Exit For End If Next If flg = False Then Cells(i, j) = p i = i + 1 If i > Rows.Count Then i = 1 j = j + 1 End If End If p = p + 1 Loop End Sub ======================
- 締切済み
- Excel（エクセル）
- VBAのDoEventsが上手く動きません
お世話になります。 ExcelのVBAで印刷処理をしているのですが、印刷枚数が多いのでDoEventsイベントを入れ、印刷中断処理を行いたいのですが、上手くできません。 印刷中ダイアログが表示されるのが原因なのでしょうか？それともコードの書き方が悪いのでしょうか？よろしくお願いします。 コードは以下のとおりです。 ************************************************ Public Can_flg As Boolean ************************************************ Private Sub CommandButton1_Click() Can_flg = True End Sub ************************************************ Private Sub UserForm_Activate() Dim ms As String Dim j As integer Can_flg = False For j = 1 To 31 DoEvents If Can_flg = True Then ms = MsgBox("印刷を中止します。", vbOKCancel) If ms = vbOK Then Exit For Else Can_flg = False End If End If Me.Label1.Caption = "印刷中です… (" & j & "/" & i & "ページ)" Sheets("テスト").PrintOut Next j Unload Me End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのVBAに関する質問です。
エクセルのVBAに関する質問です。 「指定フォルダ（ここではXXXX）内の全てのエクセルファイルを開き、内容を転記していく」 というマクロについての質問です。 ネットを参照し、以下のマクロを見つけました。 -------------------------------------------------------------------------- Sub Macro1() Dim theName As String Dim theDir As String Dim theBook As Workbook Dim flg As Boolean flg = True Application.ScreenUpdating = False theDir = ThisWorkbook.Path & "\XXXX" theName = Dir(theDir & "\*.xls") Do While theName <> "" Set theBook = Workbooks.Open(theDir & "\" & theName) Call subA(theBook, flg) flg = False theBook.Close theName = Dir Loop End Sub Sub subA(theBook As Workbook, flg As Boolean) Dim thetbl As Range, LRow As Long Set thetbl = theBook.Sheets(1).Range("A1").CurrentRegion thetbl.Copy With ThisWorkbook.ActiveSheet LRow = .Range("A65536").End(xlUp).Row If LRow = 1 Then .Range("A" & LRow).PasteSpecial xlPasteValues Else .Range("A" & LRow + 1).PasteSpecial xlPasteValues End If End With Application.CutCopyMode = False End Sub -------------------------------------------------------------------------- 実際にはこのマクロは上手く動作していますが、１つ疑問があります。 「一度開いたファイルは開かない」というのはどの部分のおかげか、ということです。 当方初心者で、分かりづらい質問かもしれませんが、どうぞご教授お願いいたします。
- ベストアンサー
- Visual Basic
- エクセルVBAのイベントで質問です。
ダブルクリックイベントで、G12:G31の範囲の文字列をB10:B27の範囲(最下行)に入れていくものを使っていますが、新たにH12:H31にある文字列もダブルクリックするとC10:C27の範囲(最下行)に入れていけるようにしたいと思います。 どのようにすればいいでしょうか。 ご存知の方いらっしゃればお教えいただけると助かります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _ Cancel As Boolean) Dim i As Long Dim flg As Boolean If Intersect(Target, Range("G12:G31")) Is Nothing Then Exit Sub If IsEmpty(Target.Value) Then Exit Sub With Worksheets("シートＡ") For i = 10 To 27 If .Range("B" & i).Value = "" Then .Range("B" & i).Value = Target.Value flg = True Exit For End If Next i If flg = False Then MsgBox .Name & " がいっぱいです。" End If End With Cancel = True End Sub
- ベストアンサー
- オフィス系ソフト
- VBA ＩＥ読み込み出来ないときの処理
エクセルＶＢＡで ＩＥ読み込み完了まで、というサンプルは有るのですが 時間来ても、読み込め無い時 中止の処理ですが、 下記で如何でしょうか（実験が出来ないので、お知恵拝借） さらに、もっと、スマートな方法が有ればご教示ください。 Set IE = CreateObject("internetExplorer.application") url = yobiurl ' "http://admin.blog.fc2.com/control.php?mode=editor&process=new" With IE .Navigate url .Visible = True i = 1 Do While .Busy = True Call Sleep(50) '0.05sec * 400 =20秒 DoEvents i = i + 1 If i > 399 Then .Quit ' End With Set IE = Nothing Exit Sub End If Loop i = 1 Do While .document.ReadyState <> "complete" Call Sleep(50) DoEvents i = i + 1 If i > 399 Then .Quit ' End With Set IE = Nothing Exit Sub End If Loop
- ベストアンサー
- Visual Basic
- VBAでWorkbook_BeforeSaveイベントで質問
Workbook_BeforeSaveイベントである条件に達していればExcelファイルを終了したくないのですがどうすればよいでしょうか？ WindowsXP ProSP2、Excel2000 コード例） Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) dim flg as boolean if flg=true then exit sub end if End Sub
- ベストアンサー
- Visual Basic
- ACCESS VBAが分からない！この問題ですが
ACCESS VBAの勉強をはじめました。 下のプロシージャを実行するとメッセージボックスに「2018/08/30」と出るようですが、なんでそうなるのかが分からないんです。 ちなみに Loop は繰り返しでWhileは～間という意味は分かるのですが。。。 よろしくお願いいたします。 Sub Lesson() Dim ret As Date, i As Long ret = #8/29/2018# Do ret = ret + 1 i = i + 1 Loop While i > 3 MsgBox ret End Sub
- ベストアンサー
- Visual Basic
- 簡単なエクセルＶＢＡ
最近エクセルのＶＢＡを勉強し始めたのですが、 1×1＝1 1×2＝2 1×3＝3 ・ ・ 9×9＝81 と出るようにしたいのですが、 Sub kuku() Do While i < 9 i = i + 1 Do While j < 9 j = j + 1 a = i * j Debug.Print i; "×"; j; "="; a Loop Loop End Sub としたところ1×9＝9までしかでません。 どうすれば上手くループするようになるでしょうか？ お願いします。
- ベストアンサー
- Visual Basic
- VBA を使用してexcel起動時に 右クリックメニューの行削除や列削除を無効にしようとするとエラーが出ることがある。
お世話になります。 VBA を使用してexcel起動時に 右クリックメニューの行削除や列削除を無効して、下記ＶＢＡを作成しました。 しかしながら、起動時（実行時）に 「実行時エラー 5 プロシージャの呼び出し、または引数が不正です。」が出ることがあります。 でないときもあるのですが、 デバック時にとまるところは、毎回変わり(1)～(5)のどれかで止まります。 使用したい環境はexcel2007,excel2003で正常に動くようにしたいのですが、何卒よろしくお願いします。 *************ソース********************* Private Sub Workbook_Open() InsertEnabled False End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) InsertEnabled True End Sub Private Sub InsertEnabled(flg As Boolean) With Application (1) Application.CommandBars("Worksheet Menu Bar").Controls("挿入(&I)").Enabled = flg (2) Application.CommandBars("Cell").Controls("挿入(&I)...").Enabled = flg (3)Application.CommandBars("Cell").Controls("削除(&D)...").Enabled = flg (4)Application.CommandBars("Row").Controls("挿入(&I)").Enabled = flg (5)Application.CommandBars("Row").Controls("削除(&D)").Enabled = flg .CommandBars.FindControl(, 296).Enabled = flg .CommandBars.FindControl(, 293).Enabled = flg End With End Sub
- ベストアンサー
- オフィス系ソフト
お礼
お答えいただきありがとうございました。早速やってみたところ上手くいきました。まさか2つ目のボタンが働いたと思いませんでした。