Макрос для набора номера из Excel

[Инн@]

Здравствуйте! Подскажите пожалуйста можно ли в Excel создать макрос, чтобы при нажатии на ячейку, в которой записан определенный номер, этот номер телефона набирался через модем, или факс, используя программу Venta fax. Заранее спасибо за ответ.

[EducatedFool]

Да, скорее всего, можно.
Даже без Venta fax
http://www.programmersforum.ru/showthread.php?t=50325

В контекстном меню Excel появляется новый пункт:



Программой Venta fax не пользовался, поэтому точно сказать не могу.
Сейчас попробую скачать, и посмотреть.

(добавлено)
Посмотрел. Возможностей у программы много, так что, наверняка, есть способ управлять ей из макроса.
Увы, помочь с макросом не могу - у меня нет модема, с которым могла бы работать Venta fax, поэтому протестировать код не получится...

---------------- добавлено позже — вдруг кому пригодится ---------------------

Недавно нашел программу, которая умеет подключаться к мобильному телефону и набирать номер.

Никакой макрос в этом случае писать не придется - программа сама установит надстройку, так что звонить Вы сможете кликнув правой кнопкой мыши по выделенной ячейке и выбрав в контекстном меню "Позвонить", только эту функцию после установки необходимо активировать, как описано вот здесь:
http://telefum.com/dokument/integration/office/excel/

Вот небольшая видеопрезентация того, как это работает: http://telefum.com/excel_call/

Если же вы хотите звонить (или отправлять СМС) при помощи макроса - то сделать это совсем несложно,
достаточно вызвать программу Zvonilka.exe с параметрами телефонного номера:

C:/Program Files/Zvonilka/Zvonilka.exe -Номер_телефона

[SAS888]

Великий Дж. Уокенбах приводит пример набора телефонного номера через модем, используя внешнюю программу дозвона (например, Dialer.exe) и метод SendKeys:

Sub CallTel()
    NTel = [A1] ' Ячейка, содержащая номер телефона
    Appname = "Dialer": AppFile = "Dialer.exe"
    On Error Resume Next: AppActivate (Appname)
    If Err <> 0 Then
        Err = 0: TaskID = Shell(AppFile, 1)
        If Err <> 0 Then MsgBox "Невозможно запустить " & AppFile
    End If
    With Application
        .SendKeys "%n" & NTel, True: .SendKeys "%d": .SendKeys "{TAB}~", True
    End With
End Sub

[Aqil_f]

Сообщение от EducatedFool

http://www.programmersforum.ru/showthread.php?t=50325

В контекстном меню Excel появляется новый пункт:

Как появляется контекстный меню Excel новый пункт?
Что надо делать для этого?

[EducatedFool]

Для начала проверь такой вариант:

Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" (ByVal Dest As String, ByVal AppName As String, ByVal CalledParty As String, ByVal Comment As String) As Long

Private Sub PhoneCall(sNumber As String, sName As String)
    Dim lRetVal As Long
    lRetVal = tapiRequestMakeCall(Trim$(sNumber), Application.Name, Trim$(sName), "")
    If lRetVal <> 0 Then
        MsgBox "error"
        'Couldn't make the call.
        'Take appropriate action
    End If
End Sub

Sub test()
    PhoneCall "89122222222", "EducatedFool"
End Sub

Нажми зеленую кнопку. Если получится позвонить - тогда всё сделаем быстро.

Как появляется контекстный меню Excel новый пункт?

Подключаем надстройку из этого поста, и смотрим исходный код:

'------------------------------------------------------------------------------
' Module "ClassApp"  in  VBAProject
'------------------------------------------------------------------------------
' (c) 27.05.2009   EducatedFool       http://ExcelVBA.ru/
'------------------------------------------------------------------------------

Public WithEvents AppEv As Application

Private Sub AppEv_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    CommandBars("cell").Reset:
    'On Error Resume Next
    N = GetPhoneNumber(Target):  If N = "" Then Exit Sub
    CommandBars("cell").Controls(1).BeginGroup = True
    Add_Control_New CommandBars("cell"), 1, 568, "TryCall", "Позвонить на номер  " & UserFormat(N), True
End Sub

[EducatedFool]

Продолжение кода:

'------------------------------------------------------------------------------
' Module "Module1"  in  VBAProject
'------------------------------------------------------------------------------
' (c) 27.05.2009   EducatedFool       http://ExcelVBA.ru/
'------------------------------------------------------------------------------

Public App As New ClassApp, N As String
Public Const CallString = """C:\Program Files\Windows Mobile Developer Power Toys\RAPI_Start\rapistart.exe"" cprog.exe -n -url tel:@@@"

Function GetPhoneNumber(ByVal txt As String) As String
    For i = 1 To Len(txt)
        letter = Mid(txt, i, 1): If IsNumeric(letter) Then GetPhoneNumber = GetPhoneNumber & letter
    Next i
    If GetPhoneNumber Like "80#########" Then Exit Function
    'Debug.Print "Error:  ", GetPhoneNumber:
    GetPhoneNumber = ""
End Function

Function UserFormat(ByVal txt As String) As String
    UserFormat = Format(txt, "#-###-###-##-##")
End Function

Sub TryCall()
    ' txt = """C:\Program Files\Microsoft Office\OFFICE11\excel.exe"" -N"
    ExecCommand = Replace(CallString, "@@@", N)
    On Error Resume Next: Err.Clear
    CreateObject("WScript.Shell").Run ExecCommand
    If Err.Number = 0 Then Exit Sub
    MsgBox "Команда  " & ExecCommand & vbNewLine & "не выполнена!", vbExclamation, "Ошибка"
End Sub

Function Add_Control_New(ByRef Comm_Bar, ByVal B_Type As Integer, ByVal B_Face As Integer, _
                         ByVal On_Action As String, ByVal B_Caption As String, Optional ByVal Begin_Group As Boolean = False, Optional Tag As String = "") As CommandBarControl
    ' добавляет контролы в меню Comm_Bar ' type=1 - это кнопка, type=4 - это комбобокс, 10 - popup
    On Error Resume Next
    Set Add_Control = Comm_Bar.Controls.Add(Type:=B_Type, Before:=1, Temporary:=True)
    With Add_Control
        If B_Face > 0 Then .FaceId = B_Face:
        .Tag = Tag: .onaction = On_Action: .Caption = B_Caption: If Begin_Group Then .BeginGroup = True
    End With
End Function

[Aqil_f]

Нажимю на зеленую кнопку.

Позвонить не получается 'по неизвестный причине'

[EducatedFool]

Позвонить не получается 'по неизвестный причине'

А телефон к компу подключен, и настроен?

[Aqil_f]

Телефон к компу подключен.

А что нужно настроить и как ?

COPY con com5
ATDномертелефона,
Это работает, значить настроен?

[sasha_prof]

Скажите пожалуйста, у меня телефон CISCO IP PHONE 7911.

Возможно ли на него посылать запрос на совершения звонка? И что для этого нужно?