マウス自動化アプリ作成（ユーザーフォーム×WindowsAPI）【ExcelVBA】

【Excel×VBA】マウス自動操作アプリ作成前編

【Excel×VBA】マウス自動操作アプリ作成後編

使用したサンプルコード

---

Option Explicit
'マウスイベントを使用するAPI　宣言コード
Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, Optional ByVal dx As Long = 0, Optional ByVal dy As Long = 0, Optional ByVal cButtons As Long = 0, Optional ByVal dwExtraInfo As LongPtr = 0)
'マウスカーソル座標を設定するAPI　宣言コード
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'マウスカーソル座標を取得するAPI　宣言コード
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Type POINTAPI
x As Long
y As Long
End Type
Public Sub メイン()

Application.Visible = False
UserForm1.Show

End Sub

Option Explicit
Private フラグ As Boolean
Private 停止フラグ As Boolean
Private ws As Worksheet
Private obj As Control
Private Rng変数 As Range
Private Sub CommandButton1_Click()

Dim 変数 As POINTAPI
フラグ = True

Do While フラグ = True

GetCursorPos 変数
Label1.Caption = 変数.x
Label2.Caption = 変数.y
UserForm1.Repaint '再描画
DoEvents 'OSに制御を渡す
Application.Wait Now + TimeValue("00:00:01")

Loop

End Sub
Private Sub CommandButton2_Click()

With ws

For Each obj In UserForm1.Controls

If obj.Name Like "TextBoxX*" Then
.Cells(Replace(obj.Name, "TextBoxX", "") + 1, 2).Value = obj.Value
ElseIf obj.Name Like "TextBoxY*" Then
.Cells(Replace(obj.Name, "TextBoxY", "") + 1, 3).Value = obj.Value
ElseIf obj.Name Like "TextBoxW*" Then
.Cells(Replace(obj.Name, "TextBoxW", "") + 1, 4).Value = obj.Value
ElseIf obj.Name Like "TextBoxK*" Then
.Cells(Replace(obj.Name, "TextBoxK", "") + 1, 5).Value = obj.Value
End If

Next

.Range("F2").Value = ComboBox1.Value

'入力がされていないセルがないかチェック
If Application.WorksheetFunction.CountBlank(.Range("A1", .Range("D1").Offset(ComboBox1.Value))) <> 0 Then
MsgBox "未入力箇所があります"
Exit Sub
End If

For Each Rng変数 In .Range("B2", .Range("B2").Offset(ComboBox1.Value - 1))
DoEvents 'OSに制御を渡す
If 停止フラグ Then
停止フラグ = False
Exit Sub
End If
移動とクリック Rng変数
Next

End With

End Sub
Private Sub CommandButton3_Click()
フラグ = False
End Sub
Private Sub CommandButton4_Click()
停止フラグ = True
End Sub

Private Sub TextBoxK5_Change()

End Sub

Private Sub UserForm_Initialize()

Set ws = Worksheets("設定")

With ws

Dim cmbrng As Range

ComboBox1.Value = .Range("F2").Value

For Each cmbrng In .Range("A2", .Range("A2").End(xlDown))
ComboBox1.AddItem cmbrng.Value
Next

For Each obj In UserForm1.Controls

If obj.Name Like "TextBoxX*" Then
obj.Value = .Cells(Replace(obj.Name, "TextBoxX", "") + 1, 2).Value
ElseIf obj.Name Like "TextBoxY*" Then
obj.Value = .Cells(Replace(obj.Name, "TextBoxY", "") + 1, 3).Value
ElseIf obj.Name Like "TextBoxW*" Then
obj.Value = .Cells(Replace(obj.Name, "TextBoxW", "") + 1, 4).Value
ElseIf obj.Name Like "TextBoxK*" Then
obj.Value = .Cells(Replace(obj.Name, "TextBoxK", "") + 1, 5).Value
End If

Next

End With

End Sub

Private Sub 移動とクリック(rngx As Range)
SetCursorPos rngx.Value, rngx.Offset(0, 1).Value
mouse_event 2
mouse_event 4
Application.Wait Now + TimeValue("00:00:" & rngx.Offset(0, 2).Value)
SendKeys rngx.Offset(0, 3).Value, True
DoEvents 'OSに制御を渡す
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Application.Visible = True
End 'プロシージャを終了する

End Sub