ExcelのVBAで、順次動作の実現
- ExcelのVBAを使用して、順番にトグルボタンを押す方法を実現する方法を紹介します。
- マクロを使用して、2秒ごとに順番にトグルボタンを押す方法を説明します。
- ToggleButton1~3のトグルボタンを順番に押すためのVBAコードを提供します。
- ベストアンサー
ExcelのVBAで、順次動作の実現
Excelのシートに、トグルボタンを3つ配置します。 ToggleButton1~3 そして、次のマクロを実行すると、2秒ごとに順番にトグルボタンが押されるのかと思いきや、6秒後に一斉にトグルボタンがへっこみます。 どうにか?2秒ごとに順番にトグルボタンが押されるように出来ないでしょうか? Sub test() Dim MyWait As String MyWait = 2 ToggleButton1.Value = True Application.ScreenUpdating = True DoEvents 'この間にもマクロを入れたい(0.1秒以内に処理できるものです) Application.Wait (Now + TimeValue("0:00:" & MyWait)) ToggleButton2.Value = True DoEvents Application.Wait (Now + TimeValue("0:00:" & MyWait)) ToggleButton3.Value = True Application.ScreenUpdating = True DoEvents End Sub
- Excel_VBA
- お礼率28% (21/73)
- オフィス系ソフト
- 回答数4
- ありがとう数0
- みんなの回答 (4)
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。 以下は、標準モジュールを標準とするマクロですから、他に入れる場合は、コードを変えなくてはなりません。なお、Application.Wait では、コードは最後まで読んでいるのに、アプリケーションのマクロ側の動き自体にWaitが掛かってしまうから、そういう現象が起こります。こういうことは厳密には、スクリプト言語ではない証拠かもしれませんね。 '標準モジュール(シートモジュールの場合は、 ' Application.OnTime myTime, Me.Name & ".TogglesClick" 'と書き換えてください。 '----------------------------------- Sub TogglesClick() Dim myTime As Date Dim j As Integer Static i As Integer Const MYWAIT As Integer = 2 '2秒 If i >= 3 Then i = 0 '自動でトグルをOffに戻す For j = 1 To 3 With ActiveSheet.OLEObjects("ToggleButton" & j) .Object.Value = False End With Next j Exit Sub End If myTime = Now + TimeSerial(0, 0, MYWAIT) i = i + 1 Application.ScreenUpdating = False DoEvents 'この間にマクロが入る '例:Cells(1, 1).Value = i Application.ScreenUpdating = True With ActiveSheet.OLEObjects("ToggleButton" & i) .Object.Value = True End With Application.OnTime myTime, "TogglesClick" '' Application.OnTime myTime, Me.Name & ".TogglesClick", 'シートモジュールの場合 End Sub
その他の回答 (3)
- imogasi
- ベストアンサー率27% (4737/17068)
Sheet3にトグルボタンを3つ貼り付けた 下記では順位処理され、うまくいっているようだが。 Application.ScreenUpdating = TrueはFALSEになっていないでしょうね。 >Excelのシートに、トグルボタンを3つ配置します。 で、Worksheets("Sheet3").・・のような限定がなくてうまくいきましたか。 ーー Sub test() Worksheets("sheet3").Select Dim MyWait As String MyWait = 2 Worksheets("Sheet3").ToggleButton1.Value = False Worksheets("Sheet3").ToggleButton2.Value = False Worksheets("Sheet3").ToggleButton3.Value = False '-- MsgBox "AAA" Worksheets("Sheet3").ToggleButton1.Value = True DoEvents 'この間にもマクロを入れたい(0.1秒以内に処理できるものです) Application.Wait (Now + TimeValue("0:00:" & MyWait)) MsgBox "BBB" Worksheets("Sheet3").ToggleButton2.Value = True DoEvents Application.Wait (Now + TimeValue("0:00:" & MyWait)) MsgBox "CCC" Worksheets("Sheet3").ToggleButton3.Value = True DoEvents End Sub
- okormazd
- ベストアンサー率50% (1224/2412)
これでどうですか。 Sub test() Dim MyWait As String MyWait = 2 Application.OnTime Now + TimeValue("0:00:" & MyWait), "toggle2" Application.OnTime Now + TimeValue("0:00:" & MyWait * 2), "toggle3" Application.ScreenUpdating = False ActiveSheet.ToggleButton1.Value = True DoEvents 'この間にもマクロを入れたい(0.1秒以内に処理できるものです) Application.ScreenUpdating = True End Sub Sub toggle2() ActiveSheet.ToggleButton2.Value = True DoEvents End Sub Sub toggle3() ActiveSheet.ToggleButton3.Value = True DoEvents End Sub
- lark_0925
- ベストアンサー率63% (37/58)
Sub test() Dim tm As Date Dim MyWait As String MyWait = 2 ToggleButton1.Value = True 'この間にもマクロを入れたい(0.1秒以内に処理できるものです) tm = Now() + TimeValue("00:00:" & MyWait) Do Until Now() > tm DoEvents Loop ToggleButton2.Value = True tm = Now() + TimeValue("00:00:" & MyWait) Do Until Now() > tm DoEvents Loop ToggleButton3.Value = True End Sub これで試してみて下さい
関連するQ&A
- エクセル VBA 自動処理の途中終了について
エクセルで単語のフラッシュカードを自動表示させたいと考えています。 エクセルの1セルの大きさを縦最大、横120位に広げ、C列に単語、D列に意味を縦に並べ、 C2 1秒後 D2 1秒後 C2 1秒後 D2 1秒後 C3 1秒後 D4 のように単語と意味を交互に2度ずつ表示させます。 For Next を使い表示はできるようになりましたが、途中で止めたいときに、escを押すと For Nextの処理を最後まで一気に行ってから止まってしまいます。 C5を表示していたら、その場所でPause をし、スタートボタンで再度継続して表示したいと思います。また、単語や意味のセルにはそれぞれ別の文字装飾をしてあるので、(赤や青、大きさなど) セルを移動して表示したいと考えています。 実は他のサイトでも質問しましたが、思ったような回答を得られませんでした。よろしくお願いします。 Sub セル移動() Dim waitTime As Variant i = 0 Range("c2").Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Range("c3").Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime For i = 1 To 50 ActiveCell.Select Selection.Offset(0, 1).Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Selection.Offset(0, -1).Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Selection.Offset(0, 1).Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Selection.Offset(1, -1).Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Application.OnKey ("{esc}"), "shuryo" i = i + 1 Next i End Sub Sub shuryo() Application.ScreenUpdating = False Range("c2").Select Application.GoTo reference:=ActiveCell, scroll:=True Application.ScreenUpdating = True Exit Sub End Sub
- ベストアンサー
- その他MS Office製品
- Excelの三つのVBAを一つにまとめる。
初めまして、よろしくお願いします。当方全くの素人でVBAの基礎もよくわからず、ネットから拾ってきていじった三つのVBAがあります。この三つ、一つ一つは個別に機能するのですが、VBAとして正しいのかさえよく解っていません。この三つを一つにまとめて、同時に機能するようにしたいと頭を抱えています。 Sub TEST() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Range("b10:b20").Insert shift:=xlShiftToRight Range("b10:b20").Value = Range("a10:a20").Value Application.OnTime TimeValue("09:00:00"), "TEST" Application.ScreenUpdating = True Application.EnableEvents = True ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST1() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c30:c40").Copy Range("d30:d40").PasteSpecial Paste:=xlPasteValues Range("b30:b40").Copy Range("c30:c40").PasteSpecial Paste:=xlPasteValues Range("a30:a40").Copy Range("b30:b40").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("01:00:00") Application.OnTime nextTime, "TEST1" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST2() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c50:c60").Copy Range("d50:d60").PasteSpecial Paste:=xlPasteValues Range("b50:b60").Copy Range("c50:c60").PasteSpecial Paste:=xlPasteValues Range("a50:a60").Copy Range("b50:b60").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("00:10:00") Application.OnTime nextTime, "TEST2" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ 解る方、よろしくお願いします。
- 締切済み
- オフィス系ソフト
- Excel2010 VBAについて
以下のソースを書いて実行したのですが 「実行エラー'1004' WorksheetFunctionクラスのVlookupプロパティを取得できません」 と表示されます Sub 時刻表示() '日本の時間と選択した年の時刻・時差を1秒ごとに表示しなおす Dim City As String Dim Jisa As Long Application.ScreenUpdating = False City = Range("C6").Value Jisa = WorksheetFunction.VLookup(City, _ Worksheets("都市リスト").Range("B3:C14"), 2, False) Range("E7").Value = Jisa Range("C4").Value = Now Range("C7").Value = DateAdd("h", Jisa, Now) Range("C4, C7").NumberFormat = "m/d h:mm:ss" Application.ScreenUpdating = True Application.OnTime Now + TimeValue("0:00:01"), "時刻表示" End Sub Sub 時刻表示終了() '時計を止める Application.OnTime Now + TimeValue("0:00:01"), "時刻表示", Schedule:=False End Sub デバックをすると Application.OnTime Now + TimeValue("0:00:01"), "時刻表示", Schedule:=False がマーカーで引かれます 一応本通りには打ったと思うのですが、、、。 どこが間違えているか教えてください
- ベストアンサー
- その他(プログラミング・開発)
- エクセルVBAの値貼り付けについて
いつもお世話になっております。 エクセルVBAについての質問ですが 以下のコードを使用するとどうしても元の書式の貼り付けになってします。 値(テキスト)貼り付けを実行したいのですがどこのコードをどのように変えればいいか教えてください。 ------------------------------------------------------------------------------------------- Sub IE_Open_Copy() Dim objIE As Object Const OLECMDID_SELECTALL = 17 Const OLECMDID_COPY = 12 Const OLECMDEXECOPT_DODEFAULT = 0 Const URL As String = "https://okwave.jp/question/" Set objIE = CreateObject("InternetExplorer.Application") With objIE .Visible = True .Navigate URL Do While .Busy DoEvents Loop Do Until .ReadyState = 4 DoEvents Loop .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT Application.Wait Now() + TimeValue("00:00:05") .Quit End With AppActivate Application.Caption, True Range("A1").Select Application.Wait Now() + TimeValue("00:00:05") Application.SendKeys "^v" Set objIE = Nothing End Sub ---------------------------------------------------------------------------------------------
- 締切済み
- Visual Basic
- エクセルのマクロのタイマー機能について
エクセルのマクロのタイマー機能について エクセルのマクロで指定した時間ごとにURLをクリックするマクロを作っています。 下記のように作っていますが、もっと簡略化して短い記述にしたく思います。 URLと指定時間は別のマクロで生成して、URLはA1~A49まで、指定時間はB1~B490までセルに書きこむようにしています。 URLはA49まで読んだらA1から読み直して10往復して、490回使用します。 使用するセルを一回ごとにずらしていくだけなので、簡単に出来そうな気もしますが、マクロ初心者のためわかりません>< 恐れ入りますが、ご教授いただければ幸いです。 ちなみにエクセル2007で作成しています。 Sub 一定の時間間隔でマクロを実行する() '進捗状況を示すために準備する 指定時刻 = Now + TimeValue("0時00分05秒") 待ち時間 = TimeValue("0時00分01秒") Application.OnTime TimeValue(指定時刻), "新規01", TimeValue(待ち時間) End Sub Sub 新規01() Range("A1").Select 'A列のURLを取得 Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True 指定時刻 = Now + Range("B1").Value 'B列の時間を取得 待ち時間 = TimeValue("0時00分01秒") Application.OnTime TimeValue(指定時刻), "新規02", TimeValue(待ち時間) End Sub Sub 新規02() Range("A2").Select Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True 指定時刻 = Now + Range("B2").Value 待ち時間 = TimeValue("0時00分01秒") Application.OnTime TimeValue(指定時刻), "新規03", TimeValue(待ち時間) End Sub ↓ 同様の記述を490回繰り返す ↓ Sub 新規建設490() Range("C1").Value = Now & " 終了" End Sub Private Sub 進捗状況を示すために準備する() Cells.Clear Columns("A:A").NumberFormatLocal = "yyyy/m/d h:mm:ss" Range("A1").Select ActiveCell.Value = Now & " 開始 " Columns("A:A").EntireColumn.AutoFit End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA IEからダウンロード
まず以下のコードを見てください(一部を抜粋) objIE.Navigate URL02 Do While objIE.Busy = True DoEvents Loop objIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT objIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT Application.Wait Now() + TimeValue("00:00:05") objIE.Quit Worksheets("商品情報").Select Range("A2:J100").Clear Range("A2").Select Application.Wait Now() + TimeValue("00:00:05") Application.SendKeys "^v", True とりあえずこれで使えてはいるのですが、これだと一度IEを終了することになるので、終了せずにエクセルのシートにペーストしたいと思いobjIE.Quitを削除しました。 そうしたらコピーまではするのですがペーストしなくなってしまいました。 なんとかIEを起動したままでペーストしたいのですが、どう直したらいいですか?教えてください。 宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- 表示されるまで待たせたい
vbaでieの操作をしているのですが Sub マクロ1() Do While ObjIE.Busy = True DoEvents Loop End Sub でも Sub マクロ2() Const READYSTATE_COMPLETE As Long = 4 Do Until ObjIE.ReadyState = READYSTATE_COMPLETE Loop End Sub でも、 表示される前に次のコードへ進んでしまって エラーになってしまいます。 表示されるまで待たせるには Application.Wait (Now + TimeValue("00:00:03")) を付け足すしかないのでしょうか? (できればこれは使いたくないです) ご教授よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- VBA EnableEventsの動作
Win7 Excel2013使用 Application.EnableEventsの動作でおかしな事がおきているので 解決方法を教えて頂きたいのですが、 シートの並びかえマクロを作成し、 その中で最初と最後にApplication.EnableEventsとscreenupdating を false→処理→trueで設定しています。 マクロ実行後、別のマクロ(sheetchangeイベント)を実行しようとしたところ マクロ動作せず、状況を調べるために sub test() msgbox Application.EnableEvents msgbox Application.ScreenUpdating End sub 上記testマクロでそれぞれの状況を表示させたところ、どちらもtrueがかえってきました。 ただ、もう一度このtestマクロを実行するとApplication.EnableEventsだけfalseとなります。 シートの並びかえマクロのデバッグで検証を行いましたが、特にエラーはなく、最後のtrueまで 実行される事は確認しました。 何か考えられることはありますでしょうか?
- 締切済み
- Excel(エクセル)
- エクセルVBA
VBAの素人です。 以下のようなVBAを実行しようと、何とか形にしました。 単独のBOOKではうまくいくのですが、同時に他のBOOKを開くと 「インデックスが有効範囲にありません」とエラーになります。 エラー箇所は、With Sheets("Sheet1").Range("B1")部分です。 修正をご教示頂ける方、何卒よろしくお願い致します。 全くVBA無知なのにすみません。 Private Sub Workbook_Open() test01 test02 Application.OnTime Now + TimeValue("00:10:00"), "終了" End Sub Sub 終了() Application.OnTime Now + TimeValue("0:00:02"), "test01", , False ThisWorkbook.Close Savechanges:=False Application.Quit End Sub Sub test01() With Sheets("Sheet1").Range("B1") .Value = Time .NumberFormatLocal = "mm:ss" End With Application.OnTime Now + TimeValue("0:00:02"), "test01" End Sub Sub test02() With Sheets("Sheet1").Range("B2") .Value = Time .NumberFormatLocal = "mm:ss" End With End Sub
- 締切済み
- オフィス系ソフト
- VBAでエクセルの表をワードに入力
Excel/Word2002使用です。 ワードへの入力を自動化するためにVBAを使用してエクセルの表をワードのテンプレートに渡したいのですが。 エクセルのA1:C8のセルに表として値が入力されています。 この表をコピーしてワードに貼り付けます。 ワード側は何も入力されていない文書ですが、 テンプレートが用意されているので、このテンプレートを指定してワードを立ち上げます。 ワードに貼り付けられる表はタブ区切りです。 具体的には下記コード3行目の”winword.exe”を具体的なテンプレートのパス名にしたいのですが・・・ Sub word貼り付け() Dim mytskID As Double Range("A1:C8").Copy mytskID = Shell("winword.exe", vbNormalFocus) Application.Wait Now + TimeValue("00:00:10") Application.SendKeys "^v", True Application.Wait Now + TimeValue("00:00:10") Application.SendKeys "%fa", True Range("A1").Copy AppActivate mytskID Application.SendKeys "^v", True Application.SendKeys "~", True Application.Wait Now + TimeValue("00:00:05") Application.SendKeys "%fx", True Application.CutCopyMode = False MsgBox "完了しました" End Sub なお、上記コードも教科書通りにしたはずなのですが、 何故か「名前をつけて保存」のSendKeys "%fa"のときだと思うのですが、 ワード側ではファイルメニューの罫線が反応してしまいます。 あわせてご教授いただければ幸いです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト