word的自动计算功能开发

逐月飞鸿

关于计算式

各位兄弟,我在word中编写结构计算书的时候,有好多计算式是：例如:
75/{84 -9×4）]+786.5
2*89+75-9+8-789/4
****等等算式,
用计算器都快算崩溃了,想编写一个这样的宏,在选中计算式如2*89+75-9+8-789/4的时候,运行一下宏,则能直接写出”=结果”,得到了高手wtkc的指点,小弟不敢独享,特将其代码公布:'.'***************************************************************************************************

'有一个很简单的办法，加入excel的引用即可，借助excel的强大计算功能，不必开发公式解析。
;选择公式后，执行宏则可
Dim xlApp As Excel.Application
Sub calculate()
    Dim formulaStr As String, resultStr As String
    formulaStr = Application.Selection
    MsgBox formulaStr                                         '如果为了提高速度可以注释掉此句
    On Error Resume Next
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Workbooks.Add
    End If
    xlApp.Cells(1, 1).formula = "=" & Left(formulaStr, Len(formulaStr) - 1)
    resultStr = xlApp.Cells(1, 1).Value
    Selection.InsertAfter resultStr
End Sub
'Reade me:运用前先加载vb的数据库:在vb的编写代码中,选中Excel的vb库,在word中
         计算:45+89-4*9*5/8....等计算式,在计算的后面,不要有等号,程序会自动写出.
         或者会出错,因为Left(formulaStr, Len(formulaStr) )中认为没有考虑.
大家还有什么更加高明的请写出!

[此贴子已经被konggs于2006-8-18 9:09:57编辑过]

逐月飞鸿

大虾们! 各位兄弟,我在word中编写结构计算书的时候,有好多计算式是：例如: 如下格式

在word的文本中有:

……(关于a的文字叙述,:如因为是13m跨径的桥梁,)

则a=75/(84 -9×4）+786.5

……关于b的文字叙述,:如因为是13m跨径的桥梁)

b=89+75-9+8-789/4 ……则:欲求的结果W=(a/b+5)*100-500

运行宏: 则能将上面的计算式写出结果,

如:a=75/(84 -9×4）+786.5=788.0625

……

b=89+75-9+8-789/4=-34.25

……

W=(a/b+5)*100-500=-2307.650073

在VBA中这样的问题很好解决,但是在word的文本中,这样的问题估计需要用到查找;替换,和调用excel的模块,还忘高手能提出解决的代码,谢谢!!!!

守柔

WORD中对于普通的四则运算以及乘方开方等运算，只须使用如下功能：

CTRL+F9：插入域括号，然后在括号内输入“=（1+2）*4/4-5+8”等等你要的数据公式然后更新域即可。

不必劳师动众吧！

逐月飞鸿

更新域的vba代码怎么写啊!?谢谢

守柔

选中域，右击更新域即可，（快捷方式：SHIFT+F9 或ALT+F9）

非得用VBA吗？

逐月飞鸿

sub mycal() '本程序用于计算公式,利用word里面域的算法 Dim formulaStr As String, resultStr As String formulaStr = Application.Selection '********************************** Selection.InsertAfter "=" Selection.MoveRight Count:=(Len(formulaStr) + 1) cc = "=" & formulaStr MsgBox "你欲求算式是?" & Chr(13) & Chr(10) & formulaStr Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _                                          Type:=wdFieldEmpty, Text:=cc, PreserveFormatting:=False) End Sub 看看是不是较好一些!(自定义一个按钮,更方便的)

(方法:选中算式如:12+45*56-78/9+5^2,再运行此宏即可)

[此贴子已经被konggs于2006-8-18 9:20:55编辑过]

守柔

抽空做了一个：

Sub CalValue()
Dim Mycal As Single, Myrange As Range, Er
On Error Resume Next
Err.Clear
Er = (Right(Selection, 1) * 1)
If Err.Number = 13 Then‘此判断主要针对选定过程中容易将段落标记选中否则可省略。
Set Myrange = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End - 1)
Else
Set Myrange = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End)
End If
Mycal = Myrange.Calculate
Myrange.InsertAfter "=" & Mycal
End Sub

[此贴子已经被konggs于2006-8-18 9:22:02编辑过]

逐月飞鸿

高啊,比我们的妙!!!那么带三角函数的怎么能解决啊?斑竹指教!!!

办公之星

　

　　CTRL+F9

　　SHIFT+F9

　　ALT+F9

　　守柔对域的研究，真是入木三分，佩服。

守柔

Sub SCTC()
Dim Mycal As Double, MyValue As Double, CalValue As Double, SelVal As Single, InSin As String
If Selection.End = Selection.Start Then MsgBox "请选定需要计算的文本!": Exit Sub
If Selection.Text Like "sin(*)" = True Then
SelVal = CSng(Mid(Selection, 5, Len(Selection) - 5))
MyValue = SelVal * 3.14159265358979 / 180
CalValue = Round(Sin(MyValue), 13)
If Abs(CalValue) < 1 Then
Selection.InsertAfter "=0" & CalValue
Else
Selection.InsertAfter "=" & CalValue
End If
Exit Sub
End If
If Selection.Text Like "cos(*)" = True Then
SelVal = CSng(Mid(Selection, 5, Len(Selection) - 5))
MyValue = SelVal * 3.14159265358979 / 180
MyValue = SelVal * 3.14159265358979 / 180
CalValue = Round(Cos(MyValue), 13)
If Abs(CalValue) < 1 Then
Selection.InsertAfter "=0" & CalValue
Else
Selection.InsertAfter "=" & CalValue
End If
Exit Sub
End If
If Selection.Text Like "tan(*)" = True Then
SelVal = CSng(Mid(Selection, 5, Len(Selection) - 5))
MyValue = (SelVal * 3.14159265358979 / 180)
MyValue = SelVal * 3.14159265358979 / 180
CalValue = Round(Tan(MyValue), 13)
If Abs(CalValue) < 1 Then
Selection.InsertAfter "=0" & CalValue
Else
Selection.InsertAfter "=" & CalValue
End If
Exit Sub
End If
If Selection.Text Like "cot(*)" = True Then
SelVal = CSng(Mid(Selection, 5, Len(Selection) - 5))
MyValue = Round(SelVal * 3.14159265358979 / 180, 13)
MyValue = SelVal * 3.14159265358979 / 180
CalValue = Round(1 / Tan(MyValue), 13)
If Abs(CalValue) < 1 Then
Selection.InsertAfter "=0" & CalValue
Else
Selection.InsertAfter "=" & CalValue
End If
Exit Sub
End If
If Selection.Text Like "[!A-Z]*" = True Then
Selection.InsertAfter "=" & Selection.Calculate
End If
Exit Sub

End Sub

感于楼主的执著,但计算终非WORD所长,勉力而作,仅供参考!(真正的计算,还应该要考虑出错的判断和处理,此处打马虎过去也!),而且只作了四个三角函数和一个四则运算,且不能连续计算,请注意.

[此贴子已经被konggs于2006-8-18 9:23:55编辑过]