Пользователь
Регистрация: 11.07.2012
Сообщений: 12
|
Код:
Sub Макрос1()
'[DllImportAttribute("User.dll")]
'private static extern int FindWindow(String ClassName, String WindowName);
'
' Макрос9 Макрос
' Макрос записан 12.07.2012 (Анна)
'
' Сочетание клавиш: Ctrl+х
' Range("C6").Select
hwnd = FindWindow(vbNullString, "Коннект Менеджер") ' "C:\Program Files\Connect Manager\UIMain.exe"
If hwnd = 0 Then ' программа не найдена среди запущенных приложений
SIPPOINTpath$ = Environ("ProgramFiles") & "\Connect Manager\UIMain.exe"
If Dir(SIPPOINTpath$, vbNormal) = "" Then Exit Sub ' выход (программа не найдена)
MsgBox "Программа «Коннект Менеджер» не запущена!", vbExclamation, "Набор номера невозможен": Exit Sub
End If
TsPanel = FindWindowEx(hwnd, 0, "TImButton", "Вызовы ")
If TsPanel <> 0 Then
'rr = PostMessage(TsPanel, bm_Click, 0, 0)
rr = SendMessage(TsPanel, WM_LBUTTONDOWN, MK_LBUTTON, 0)
rr1 = SendMessage(TsPanel, WM_LBUTTONUP, MK_LBUTTON, 0)
TsPanel = FindWindowEx(hwnd, 0, "TVictorPanel", "")
Tsp = FindWindowEx(TsPanel, 0, "TCall_managerform", "Вызовы ")
Ts = FindWindowEx(Tsp, 0, "TMemo", "")
' hwnd = FindWindow(vbNullString, "SPYXX.txt - AkelPad")
' Ts = FindWindowEx(hwnd, 0, "RichEdit20W", "")
tt = ActiveCell.Text
For i = 1 To Len(tt)
Sleep (100)
If IsNumeric(Mid(tt, i, 1)) = True Then
If Mid(tt, i, 1) = "0" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (200)
'rr = PostMessage(Ts, WM_KEYDOWN, VK_0, 0)
'rr = PostMessage(hwnd, WM_CHAR, VK_0, 0)
rr = PostMessage(Ts, WM_KEYUP, VK_0, 1)
End If
If Mid(tt, i, 1) = "1" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_1, 1)
End If
If Mid(tt, i, 1) = "2" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_2, 1)
End If
If Mid(tt, i, 1) = "3" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_3, 1)
End If
If Mid(tt, i, 1) = "4" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_4, 1)
End If
If Mid(tt, i, 1) = "5" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_5, 1)
End If
If Mid(tt, i, 1) = "6" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_6, 1)
End If
If Mid(tt, i, 1) = "7" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_7, 1)
End If
If Mid(tt, i, 1) = "8" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_8, 1)
End If
If Mid(tt, i, 1) = "9" Then
rr = SendMessage(Ts, WM_SETFOCUS, 0, 0)
Sleep (100)
rr = PostMessage(Ts, WM_KEYUP, VK_9, 1)
End If
End If
Next
hwnd = FindWindow(vbNullString, "Коннект Менеджер")
TsPanel = FindWindowEx(hwnd, 0, "TVictorPanel", "")
Dim fo As RECT
rr = GetWindowRect(TsPanel, fo)
Tsp = FindWindowEx(TsPanel, 0, "TCall_managerform", "Вызовы ")
Ts = FindWindowEx(Tsp, 0, "TImButton", "")
Dim pp As RECT
For i = 1 To 22
rr = GetWindowRect(Ts, pp)
If ((pp.Left - fo.Left) = 223) Then
rr = SendMessage(Ts, WM_LBUTTONDOWN, MK_LBUTTON, 0)
rr1 = SendMessage(Ts, WM_LBUTTONUP, MK_LBUTTON, 0)
Exit For
End If
Ts = GetNextWindow(Ts, GW_HWNDNEXT)
Next
'Ts = FindWindowEx(Tsp, 0, "TImButton", "")
'Dim retval As Long ' возвращаемое значение
' retval = EnumChildWindows(Tsp, AddressOf EnumChildProc, 0)
'
End If
'ActiveCell = EnumChildWindows(hWnd, EnumFunc(), 0)
' but1 = FindWindowEx(hWnd, 0, "TButton", "Вызовы")
' PostMessage(but1,bm_Click,0,0)
End Sub
Код:
Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim sSave As String
' Получим длину текста
sSave = Space$(GetWindowTextLength(hwnd) + 1)
' Получим текст
GetWindowText hwnd, sSave, Len(sSave)
' Удалим завершающий нулевой символ Chr$(0)
sSave = Left$(sSave, Len(sSave) - 1)
If sSave <> "" Then EnumChildProc = 0
' Продолжим перечисление
If sSave = "" Then EnumChildProc = 1
End Function
Последний раз редактировалось EducatedFool; 09.08.2012 в 12:59.
|