Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 09.08.2012, 12:31   #21
ura12345678
Пользователь
 
Регистрация: 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.
ura12345678 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц