エクセルバージョン
マイクロソフト365
今回はWindowsAPIをしようしてyoutube動画やGOMやVLCなど、毎回同じ場所で同じ時間、指定回数くりかえしクリックさせて、歌の練習や英語の発音のなどを効率よく学習できるような機能を作成してみたいと思います。
簡単にいうとA↔B区間リピートみたいな事がエクセルVBAで実現できますｷｬ━━━━(ﾟ∀ﾟ)━━━━!!
まずは下記の動画を見てどんな感じのことができるか見て確認してみてください。
【完成後】
➀【歌をピンポイントで連続自動再生】
3.5秒間隔で10回自動で繰り返します。
今回の歌のサンプルはヒルクライムの春夏秋冬です(*^^)v
➁【英語の発音をピンポイントで連続自動再生】
2.8秒間隔で10回自動でネイティブ英会話のワンシーンを繰り返します＼(^^)／
このように0.1秒単位で時間指定をして、何回でも同じ再生位置で繰り返して動画を再生できます。
それではいってみましょう(((^-^)))
Menu
作成手順
・シートに各パラメータを作成
・座標を取得
・座標をセットしてクリック
・時間と繰り返し処理
・停止ボタンを作成
ざっくりこんな感じの手順で作成していきたいと思います。
シートにON、OFFのリストを作成
カーソル位置の座標をリアルタイムに表示させるための切り替え処理として、シートを編集しリストボックスを追加します。
データをクリックします。
データ入力規則をクリックします。
1から4までできたらOKボタンを押します。
B1セルに以下のように表示されます。
ON,OFFリストが作成できたら、下記の図のようにシートを編集します。
シートモジュール
B1セルの値のON,OFFが切り替わったら座標取得を実行するためにChangeイベントを作成します。
シートモジュールの作成法 → シートモジュール
1 2 3 4 5 6 7 8 9 | Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Value = "ON" And Target = Range("B1") Then Call 座標取得 '座標取得をCall(実行) Else Exit Sub End If End Sub |
座標位置を取得
再生位置のマウスカーソルの座標を取得するためにWindowsAPI（GetCursorPos）を使用します。
詳細を知りたい方は下記の過去の記事で詳しく解説しています。
標準モジュールに下記をコピペします → 標準モジュール
APIとは → APIとは（Windows API）
リアルタイム座標 → リアルタイムに座標を表示させる
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | Option Explicit 'APIを宣言 'カーソルの座標位置を取得するAPI Declare Function GetCursorPos Lib "user32" (lpPoint As apiGetCursorPos) As Long '構造体 Private Type apiGetCursorPos x As Long y As Long End Type Sub 座標取得() '変数 Dim pos As apiGetCursorPos Do While Range("B1") = "ON" 'ONの間ループ DoEvents 'osに操作を移行 GetCursorPos pos 'カーソル位置取得 Range("B2") = pos.x Range("B3") = pos.y Loop Range("B2").ClearContents 'セルB2の値をクリア Range("B3").ClearContents 'セルB3の値をクリア End Sub |
B1セルをONにすると、B2セルとB3セルにリアルタイムにxとy座標が表示されます。
B1セルをOFFにすると、B2セルとB3セルの値が非表示になります。
座標位置をセットしてクリック
標準モジュールを作成
マウスカーソルの座標をセットするためにWindowsAPI（SetCursorPos）を使用します。
マウスの左をクリックするためにWindowsAPI（mouse_event）を使用します。
標準モジュールに下記をコピペします → 標準モジュール
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | Option Explicit '座標位置にカーソルををセットさせるAPI Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long 'マウスをクリックをするAPI Declare Sub mouse_event Lib "user32" ( _ ByVal dwFlags As Long, _ Optional ByVal dx As Long = 0, _ Optional ByVal dy As Long = 0, _ Optional ByVal dwDate As Long = 0, _ Optional ByVal dwExtraInfo As Long = 0) Sub 座標セット確認() Dim xPos As Long Dim yPos As Long xPos = Range("B4").Value yPos = Range("B5").Value Debug.Print xPos & " : " & yPos Dim insClass1 As New Class1 insClass1.Left_Click xPos, yPos End Sub |
クラスを作成
クラスモジュールに下記をコピペします → クラスモジュール
このクラスで指定の座標位置をクリックします。
1 2 3 4 5 6 7 8 9 | Option Explicit '第1引数 x座標 '第2引数 y座標 '内容：座標位置で左クリック Sub Left_Click(x As Long, y As Long) SetCursorPos x, y 'x座標とy座標をセットAPI mouse_event 2 '左ボタン押すAPI &H2 mouse_event 4 '左ボタン離すAPI &H4 End Sub |
コードのコピペが済んだら
➀B1セルをOFFにします。
➁B4セルとB5セルに適当に座標x,yの値を数字で記入します（適当な数字でOKです）
下記のようにマウスカーソルが座標位置に飛んで行けばOKです。
今回の下記サンプル画像ではB7セルにカーソルが飛んでいます。
見えませんがB7セルにカーソルが移動後にクリックもしています。
シートにボタンを作成して実行したい場合 → マクロボタン作成方法
繰り返しと時間設定
今回は過去の記事を応用して作成しています。
詳細は下記で詳しく解説しています。
➀繰り返し処理 → For
➁タイマーセット → 処理時間を測定したり,待ってから動作させるTimer
➂Do While → Do While
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | Sub Play() '変数 Dim xPos As Long Dim yPos As Long Dim cnt, i As Integer Dim stopTime, startTime 'セット内容 xPos = Range("B4").Value 'x座標をセット yPos = Range("B5").Value 'y座標をセット cnt = Range("B6").Value '繰り返し回数 stopTime = Range("B7").Value '再生時間 'オブジェクト作成 Dim insClass1 As New Class1 'インスタンス生成してx座標とy座標をセット insClass1.Left_Click xPos, yPos '繰り返し処理➀ For i = 1 To cnt - 1 startTime = Timer 'スタート時間をセット➁ Do While Timer < startTime + stopTime 'Doループ③ DoEvents 'OSに処理を渡す Loop insClass1.Left_Click xPos, yPos Next Set insClass1 = Nothing 'オブジェクト破棄 MsgBox "FINISH" End Sub |
これで繰り返しと再生時間の設定が済んだのでほぼ完成です。
あとは停止ボタンを作成して途中で停止できるようにします。
停止ボタン
最後になりますが再生途中に停止させたい場合などあると思うので停止ボタンを作成します。
標準モジュールに下記を作成
1 2 3 | Sub 処理終了() canBtn = True End Sub |
playマクロのDo Eventsの後にIF条件で挿入します。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | '繰り返し処理 canBtn = False For i = 1 To cnt - 1 startTime = Timer 'スタート時間をセット Do While Timer < startTime + stopTime '再生ループ DoEvents 'OSに処理を渡す If canBtn = True Then '処理停止 Exit For End If Loop insClass1.Left_Click xPos, yPos Next |
メンバー変数として一番目のプロシージャの上に記述します。
1 | Dim canBtn As Boolean '停止bool |
これで完成です＼(^^)／
VBA全サンプルコード
VBAがわからなくて即コピペして試したい方は、ここからを手順どおりで実行できます(*^^)v
標準モジュール
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | Option Explicit 'WindowsAPIを使用 'カーソルの座標位置を取得するAPI Declare Function GetCursorPos Lib "user32" (lpPoint As apiGetCursorPos) As Long 'カーソルの座標位置をセットするAPI Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long 'マウスをクリックをするAPI Declare Sub mouse_event Lib "user32" ( _ ByVal dwFlags As Long, _ Optional ByVal dx As Long = 0, _ Optional ByVal dy As Long = 0, _ Optional ByVal dwDate As Long = 0, _ Optional ByVal dwExtraInfo As Long = 0) '構造体 Private Type apiGetCursorPos x As Long y As Long End Type Dim canBtn As Boolean '停止bool Sub 座標取得() '変数 Dim pos As apiGetCursorPos Do While Range("B1") = "ON" 'ONの間ループ DoEvents 'osに操作を移行 GetCursorPos pos 'カーソル位置取得 Range("B2") = pos.x Range("B3") = pos.y Loop Range("B2").ClearContents 'セルB2の値をクリア Range("B3").ClearContents 'セルB3の値をクリア End Sub Sub Play() '変数 Dim xPos As Long Dim yPos As Long Dim cnt, i As Integer Dim stopTime, startTime If Range("B1") = "ON" Then MsgBox "OFFにしてください" Exit Sub End If 'セット内容 xPos = Range("B4").Value 'x座標をセット yPos = Range("B5").Value 'y座標をセット cnt = Range("B6").Value '繰り返し回数 stopTime = Range("B7").Value '再生時間 'オブジェクト作成 Dim insClass1 As New Class1 'インスタンス生成してx座標とy座標をセット insClass1.Left_Click xPos, yPos '繰り返し処理 canBtn = False For i = 1 To cnt - 1 startTime = Timer 'スタート時間をセット Do While Timer < startTime + stopTime '再生ループ DoEvents 'OSに処理を渡す If canBtn = True Then '処理停止 Exit For End If Loop insClass1.Left_Click xPos, yPos Next Set insClass1 = Nothing 'オブジェクト破棄 End Sub Sub 処理終了() canBtn = True '処理を停止するBool End Sub |
シートモジュール
シートモジュールに下記をコピペします → シートモジュール
1 2 3 4 5 6 7 8 9 | Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Value = "ON" And Target = Range("B1") Then Call 座標取得 '座標取得をCall(実行) Else Exit Sub End If End Sub |
クラスモジュール
クラスモジュールに下記をコピペします → クラスモジュール
1 2 3 4 5 6 7 8 9 | Option Explicit '第1引数 x座標 '第2引数 y座標 '内容：座標位置で左クリック Sub Left_Click(x As Long, y As Long) SetCursorPos x, y 'x座標とy座標をセットAPI mouse_event 2 '左ボタン押すAPI &H2 mouse_event 4 '左ボタン離すAPI &H4 End Sub |
実行手順
①エクセルを開いてショートカットキーのAlt + F11でVBAを起動します。
②各モジュールにサンプルコードをコピペします。
➂VBAの再生ボタンもしくはF5キーを押して実行します。
最終的には途中で停止できるように、再生ボタンと停止ボタンを作成して実行します。
【ボタンに登録するマクロ】
再生ボタン → Play
停止ボタン → 処理終了
登録方法 → マクロボタン作成方法
※再生する場合の座標位置は毎回同じ座標をクリックするので動画プレイヤーの位置は毎回同じ位置にしておきましょう。
まとめ
WindowsAPIを使用すれば簡単にピンポイントで同じ場所でクリックさせることが可能になります。
今回はyoutube動画のサンプルで解説しましたが、GOMやVLCプレイヤーなどの動画でも実行可能です。
あとは少しＶＢＡを編集すれば動画の見たい座標位置をセルに複数登録しておき、すぐに見たい再生ポイントからいつでも再生することも可能です。
エクセルもAPIを使用すれば結構なんでもできますねっ(★‿★)
以上です。
