调用计算器并返回结果的例子

 API调用计算器的例子，实现不同程序的数据交换。此方法同样适用其他OFFICE组件的调用（可能要稍作修改）
基本原理：寻找计算器的EDIT句柄，用SendMessage返回结果，并不算复杂。

模块代码：

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC

Function TxtValFrmCal(Ctl As Control, intDecimals As Integer) As Currency
 
 '=======================================================
 '功能: 调用计算器并返回结果到指定的控件
 '参数: ctl 为需要返回结果的控件名称
 '      intDecimals  保留小数的位数
 '用法: TxtValFrmCal Me.Text1, 3
'       ctl 格式须设置为常规数字
 '作者: andymark
 ' QQ : 42503577  Email : [e-mail]
 '日期: 2008-2-22
 
 '======================================================
 
 Dim CalcHwnd As Long
 Dim pResult As String
 Dim DblCal As Currency
 Dim EditText As String
 Dim EditHwnd As Long
 Dim Check As Boolean
 Dim StrTxt As String
  
 '打开计算器
 Shell "calc"
 '取计算器窗口句柄
 CalcHwnd = FindWindow("SciCalc", vbNullString)
 '取计算器显示结果的窗口句柄,通过工具可知道该窗口类名为Edit
 EditHwnd = FindWindowEx(CalcHwnd, 0, "Edit", vbNullString)
  DoEvents
 If IsNumeric(Ctl.Value) And Not IsNull(Ctl.Value) Then
    SendMessage EditHwnd, WM_SETTEXT, 0, ByVal CStr(Ctl.Value)
 End If
 Check = True

 '下面主要是检测计算器是否关闭
 Do ' 外层循环。
 
   Do While EditHwnd <> 0 ' 内层循环。
      CalcHwnd = FindWindow("SciCalc", vbNullString)
      EditHwnd = FindWindowEx(CalcHwnd, 0, "Edit", vbNullString)
       '判断计算器是否关闭
      If EditHwnd = 0 Then   ' 如果条件为 True...
         
          Check = False      ' 将标志值设置为 False。

          Exit Do            ' 终止内层循环。
     
      Else
     
          '取计算器的值
          EditText = Space(SendMessage(EditHwnd, WM_GETTEXTLENGTH, ByVal 0, ByVal 0))
          SendMessage EditHwnd, WM_GETTEXT, ByVal Len(EditText) + 1, ByVal EditText
          '临时赋给变量
          pResult = EditText
         
          DoEvents     '这个起延时作用,否则不能正确返回数值
         
           '判断  pResult的值是否为空,代表是否关闭计算器
         
          If Len(Trim(pResult)) <> 0 Then
             If Right((pResult), 1) = "." Then
                pResult = Mid(pResult, Len(pResult) - 1)
             End If
              DblCal = CCur(pResult)
          End If
 
      End If
     
  Loop
 
Loop Until Check = False ' 立即终止外层循环

'控件赋值并按要求四舍五入
 ' DblCal = CCur(DblCal)
  Ctl.Value = RoundToLarger(DblCal, intDecimals)

End Function

Public Function RoundToLarger(dblInput As Currency, intDecimals As Integer) As Currency   '四舍五入
    Dim strFormatString As String
    If dblInput <> 0 Then
        strFormatString = "#." & String(intDecimals, "#")
        RoundToLarger = Format(dblInput, strFormatString)
    Else
        RoundToLarger = 0
    End If
End Function

窗体代码：

Private Sub Command0_Click()
TxtValFrmCal Me.Text1, 3
End Sub

Private Sub Command5_Click()
TxtValFrmCal Me.Text3, 1
End Sub

Private Sub Command8_Click()
TxtValFrmCal Me.Text6, 2
End Sub