Drittprogramm fernsteuern

Option Explicit
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Boolean
Private Declare Function SetForegroundWindow Lib "User32" (ByVal hWnd As Long) As Long
Private Const GW_HWNDNEXT = 2
Private Declare Sub mouse_event Lib "User32" _
( _
ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
Private Declare Function GetCursorPos Lib "User32" (cPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Public Const MOUSE_LEFT = 0
Public Const MOUSE_MIDDLE = 1
Public Const MOUSE_RIGHT = 2
Private Declare Sub keybd_event Lib "User32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Const KEYUP = &H2
Public Sub SendMausklick(ByVal mButton As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
If (mButton = MOUSE_LEFT) Then
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
ElseIf (mButton = MOUSE_MIDDLE) Then
Call mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
Else
Call mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
End If
End Sub
Private Function GetHandleFromPartialCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
Dim lhWndP As Long
Dim sStr As String
GetHandleFromPartialCaption = False
lhWndP = FindWindow(vbNullString, vbNullString)
Do While lhWndP  0
sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
GetWindowText lhWndP, sStr, Len(sStr)
sStr = Left$(sStr, Len(sStr) - 1)
If InStr(1, sStr, sCaption) > 0 Then
GetHandleFromPartialCaption = True
lWnd = lhWndP
Exit Do
End If
lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
Loop
End Function
Sub DP()
Dim sTxt As String * 255, t As String, sSuch As String, i, ii
Dim lhWndP As Long
If GetHandleFromPartialCaption(lhWndP, "Drittprogramm") = True Then
SetForegroundWindow lhWndP
End If
Call keybd_event(91, 0, 0, 0) 'Windows Taste
Call keybd_event(38, 0, 0, 0) 'UP
Call keybd_event(91, 0, KEYUP, 0)
Call keybd_event(38, 0, KEYUP, 0)
SendKeys "x", True
SendKeys "%v", True
Call Timer40
SendKeys "s", True
Call Timer40
SendKeys "a", True
Call Timer40
i = 0
For i = 1 To 6
SendKeys i & "+^{RIGHT}", True
Call Timer40
Next i
Call Move_Cursor_to
SendMausklick MOUSE_LEFT
ii = 0
For ii = 1 To 22
SendKeys ii & "{down}", True
Call Timer40
Next ii
Call Move_Cursor_to2
SendMausklick MOUSE_LEFT
SendMausklick MOUSE_LEFT
Call Timer1000
SendKeys "{F2}", True
Call Timer750
SendKeys "%s", True
If GetHandleFromPartialCaption(lhWndP, "Mustermappe.xlsm - Excel") = True Then
SetForegroundWindow lhWndP
End If
'AppActivate ThisWorkbook.Name
'Application.WindowState = xlMaximized
End Sub
Sub Move_Cursor_to()
Dim x As Long, y As Long, n As Long
x = 600
y = 270
n = SetCursorPos(x, y)
End Sub
Sub Move_Cursor_to2()
Dim x As Long, y As Long, n As Long
x = 900
y = 770
n = SetCursorPos(x, y)
End Sub