Как Звонить через Excel

Пользователь

Сообщений: 3 Регистрация: 01.01.1970

04.09.2013 15:45:29

Всем доброго времени суток. Недавно я задался таким вопросом: пользуясь IP телефонией, через программу Sippoint, как звонить не набирая номер в ручную, а щелкая по ячейке с номером.
В инете нашел такой макрос:

Код

Sub ПозвонитьНаНомерИзВыделеннойЯчейкиExcel()
   CallWithSIPPOINT Trim(ActiveCell)
End Sub
 
Sub CallWithSIPPOINT(ByVal number$)
    ' пытается набрать номер number$ в программе SIPPOINT
   On Error Resume Next: Err.Clear: res = 0

    Hwnd& = FindWindow("TForm1", "Sippoint ")    ' получаем Hwnd& окна запущенного приложения
   If Hwnd& = 0 Then    ' программа не найдена среди запущенных приложений
       SIPPOINTpath$ = Environ("ProgramFiles") & "\Sippoint\Sippoint.exe"
        If Dir(SIPPOINTpath$, vbNormal) = "" Then Exit Sub    ' выход (программа не найдена)
       ' pid& = Shell(SIPPOINTpath$): DoEvents    ' запускаем программу
       MsgBox "Программа «Sippoint» не запущена!", vbExclamation, "Набор номера невозможен": ExitSub
    End If
    If Hwnd& = 0 Or Err > 0 Then Exit Sub    ' так и не удалось запустить программу - выходим из макроса

    TsPanel1& = FindWindowEx(Hwnd&, 0, "TsPanel", vbNullString)
    TsPanel2& = FindWindowEx(Hwnd&, TsPanel1&, "TsPanel", vbNullString)
    TsPageControl& = FindWindowEx(TsPanel2&, 0, "TsPageControl", vbNullString)
    TsTabSheet& = FindWindowEx(TsPageControl&, 0, "TsTabSheet", vbNullString)
    While FindWindowEx(TsTabSheet&, 0, "TVirtualStringTree", vbNullString) <> 0
        TsTabSheet& = FindWindowEx(TsPageControl&, TsTabSheet&, "TsTabSheet", vbNullString)
    Wend
    TsEdit& = FindWindowEx(TsTabSheet&, 0, "TsEdit", vbNullString)
    SendButton& = FindWindowEx(TsTabSheet&, 0, "TsBitBtn", vbNullString)

    ' вводим заданный текст в поле для номера в программе sippoint
   res = res - SendMessage(TsEdit&, WM_SETTEXT, 3, number$)

    ' нажимаем кнопку ВЫЗОВ
   res = res - SendMessage(SendButton&, WM_LBUTTONDOWN, 0, vbNullString)
    res = res - SendMessage(SendButton&, WM_LBUTTONUP, 0, vbNullString)
    
    If TsEdit& * SendButton& Then Debug.Print "Набран номер " & number$
End Sub

Но что-то он не хочет работать. Выделяет FindWindow и пишет: Compile error: Sub or Function not defined Разобраться почему, у меня не получается.

Может кто подскажет как тут быть?

EducatedFool

Пользователь

Сообщений: 3695 Регистрация: 23.12.2012

04.09.2013 15:52:52

Вы бы хоть дали ссылку на статью, где взяли код:
http://excelvba.ru/code/Sippoint

Надо объявить все константы и API-функции, - тогда все заработает
В прикрепленном к статье файле все это сделано.

PS: Сами не сможете разобраться, - обращайтесь, сделаю (не бесплатно)

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Hugo

Пользователь

Сообщений: 26326 Регистрация: 22.12.2012

04.09.2013 15:57:49

Там где нашли, выше не было нечто похожее на

Код
Private Declare Function FindWindow _ Lib "user32.dll" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long

Ну и с FindWindowEx тоже вероятно нужно разобраться.

EducatedFool

Пользователь

Сообщений: 3695 Регистрация: 23.12.2012

04.09.2013 16:52:22

Вставьте это над макросом:

Скрытый текст

Код

#If Win64 Then
    #If VBA7 Then    ' Windows x64, Office 2010
        Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongLong) As LongLong
        Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongLong, ByVal nCmdShow As Integer) As Integer
        Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongLong, ByVal wMsg As LongLong, ByVal wParam As Integer, ByVal lParam As Any) As LongLong
        Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongLong) As LongLong
        Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongLong, ByVal wCmd As LongLong) As LongLong
        Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongLong
        Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongLong, lpdwprocessid As LongLong) As LongLong
        Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As LongLong, ByVal hwndChildAfter As LongLong, ByVal lpszClass As String, ByVal lpszWindow As String) As LongLong
    #Else    ' Windows x64,Office 2003-2007
        Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongLong) As LongLong
        Declare Function ShowWindow Lib "user32" (ByVal hwnd As LongLong, ByVal nCmdShow As Integer) As Integer
        Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongLong, ByVal wMsg As LongLong, ByVal wParam As Integer, ByVal lParam As Any) As LongLong
        Declare Function GetParent Lib "user32" (ByVal hwnd As LongLong) As LongLong
        Declare Function GetWindow Lib "user32" (ByVal hwnd As LongLong, ByVal wCmd As LongLong) As LongLong
        Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongLong
        Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongLong, lpdwprocessid As LongLong) As LongLong
        Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As LongLong, ByVal hwndChildAfter As LongLong, ByVal lpszClass As String, ByVal lpszWindow As String) As LongLong
    #End If
#Else
    #If VBA7 Then    ' Windows x86, Office 2010
        Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
        Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Integer) As Integer
        Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
        Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
        Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
        Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long
        Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
    #Else    ' Windows x86, Office 2003-2007
        Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
        Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Integer) As Integer
        Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
        Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
        Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
        Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long
        Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
    #End If
#End If

Public Const STARTF_USESHOWWINDOW = &H1, STARTF_USESTDHANDLES = &H100, GW_HWNDNEXT = 2
Public Const WM_LBUTTONDOWN = &H201, WM_LBUTTONUP = &H202, WM_USER = &H400
'  Window Messages
Public Const WM_NULL = &H0, WM_CREATE = &H1, WM_DESTROY = &H2, WM_MOVE = &H3, WM_SIZE = &H5, WM_ACTIVATE = &H6
Public Const WM_SETFOCUS = &H7, WM_KILLFOCUS = &H8, WM_ENABLE = &HA, WM_SETREDRAW = &HB, WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD, WM_GETTEXTLENGTH = &HE, WM_PAINT = &HF, WM_CLOSE = &H10, WM_QUERYENDSESSION = &H11
Public Const WM_QUIT = &H12, WM_QUERYOPEN = &H13, WM_ERASEBKGND = &H14, WM_SYSCOLORCHANGE = &H15
Public Const WM_ENDSESSION = &H16, WM_SHOWWINDOW = &H18, WM_CTLCOLOR = &H19, WM_WININICHANGE = &H1A
Public Const WM_DEVMODECHANGE = &H1B, WM_ACTIVATEAPP = &H1C, WM_FONTCHANGE = &H1D, WM_TIMECHANGE = &H1E
Public Const WM_CANCELMODE = &H1F, WM_SETCURSOR = &H20, WM_MOUSEACTIVATE = &H21, WM_CHILDACTIVATE = &H22
Public Const WM_QUEUESYNC = &H23, WM_GETMINMAXINFO = &H24, WM_PAINTICON = &H26, WM_ICONERASEBKGND = &H27
Public Const WM_NEXTDLGCTL = &H28, WM_SPOOLERSTATUS = &H2A, WM_DRAWITEM = &H2B, WM_MEASUREITEM = &H2C
Public Const WM_DELETEITEM = &H2D, WM_VKEYTOITEM = &H2E, WM_CHARTOITEM = &H2F, WM_SETFONT = &H30, WM_GETFONT = &H31

Public Const SW_HIDE = 0, SW_SHOWNORMAL = 1, SW_NORMAL = 1, SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3, SW_MAXIMIZE = 3, SW_SHOWNOACTIVATE = 4, SW_SHOW = 5
Public Const SW_MINIMIZE = 6, SW_SHOWMINNOACTIVE = 7, SW_SHOWNA = 8, SW_RESTORE = 9, SW_SHOWDEFAULT = 10, SW_MAX = 10

Изменено: EducatedFool - 07.09.2013 14:09:28

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

P-S-A Пользователь Сообщений: 3 Регистрация: 01.01.1970	#5 04.09.2013 17:03:54 EducatedFool, большое спасибо. Но у меня все равно пока не получается. Буду пробовать...

P-S-A Пользователь Сообщений: 3 Регистрация: 01.01.1970	#6 05.09.2013 13:25:40 Все работает, разобрался. Большое, огромное спасибо!!!

Читают тему