如何查找公式编辑器编写的内容(vba也好)

skyya · 发表于 2009-3-5 21:01

守版主有没有办法

守柔 · 发表于 2009-3-6 09:32

原帖由 skyya 于 2009-3-5 21:01 发表
守版主有没有办法

不知楼主此举意欲何为呢？
如果结果只是在Word中，没有很好的方法。
如果是将公式的结果生成方正注解，可以参考“WD2BD智能王”的功能。

skyya · 发表于 2009-3-14 22:04

原帖由守柔于 2009-3-6 09:32 发表

不知楼主此举意欲何为呢？
如果结果只是在Word中，没有很好的方法。
如果是将公式的结果生成方正注解，可以参考“WD2BD智能王”的功能。

回守版主的话,我是想在word中查找.虽然有点遗憾，但还是谢谢你的答复

小fisher · 发表于 2009-3-16 12:09

楼主说的是这样吗：

对应的VBA代码是Selection.Range.GoToNext(wdGoToEquation).Select
如果要选中公式对象，加上一句selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend

[ 本帖最后由小fisher 于 2009-3-16 12:18 编辑 ]

skyya · 发表于 2009-3-27 07:59

原帖由 小fisher 于 2009-3-16 12:09 发表
楼主说的是这样吗：
475681
对应的VBA代码是Selection.Range.GoToNext(wdGoToEquation).Select
如果要选中公式对象，加上一句selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend

谢谢小fisher,不过我要的是比较两个公式内容是否一致,不是定位公式!

小fisher · 发表于 2009-3-27 14:28

原帖由 skyya 于 2009-3-27 07:59 发表

谢谢小fisher,不过我要的是比较两个公式内容是否一致,不是定位公式!

因为公式是嵌入在word中的OLE对象，word只能在外部把它作为一个整体进行操作（比如插入、删除、修改大小、位置、复制、剪切等），但是不能进入到它的内部读取或修改其中的一部分，真正可以编辑修改公式的程序是双击它时激活的公式编辑器程序，但公式编辑器是独立于word和VBA之外的，所以用VBA很难通过常规方法获取其中的内容。
如果是单纯比较两个公式内容是否一致，我倒是有办法，就是先用VBA选中其中一个公式，使用复制命令，然后从剪贴板中获取其中一种格式的二进制数据放到一个byte数组中，然后对另一个公式进行同样操作，最后再按字节对比就行了
如果是要查找其中的字符串，先用VBA选中它并复制，然后从剪贴板中获取CF_ENHMETAFILE格式的数据，然后用EnumEnhMetaFile API函数分析其中类型为EMR_EXTTEXTOUTA或EXTTEXTOUTW的记录，应该也可以得到。

skyya · 发表于 2009-5-17 20:33

前一种用二进制比较我倒是试过,但即使相同的内容,因为格式不同也会不一样,所以不好用,兄台的第二种方法,让我佩服万分,只是不知怎样获取CF_ENHMETAFILE格式的数据,又怎样EnumEnhMetaFile API函数分析其中类型为EMR_EXTTEXTOUTA或EXTTEXTOUTW的记录，期待兄台详细指点!!谢谢

20wangz · 发表于 2009-5-19 21:18

我的工作就是天天与公式打交道，所以有一些自己的心得，正好就教于各位大方之家。

如果是要查找公式中的内容，在WORD中也不是没有办法，不过要借助一个中介，这就是TeX代码。

比如我要查找公式中的x=y，具体过程可见所附动画。这个动画演示了如图把所有的公式都转换成TeX代码，然后使用WORD的“查找与替换”查找“x=y”的过程，最后把所有的公式TeX代码再复原成公式。

虽然可以通过这种方式查找，但如果通过这种方式比较公式，估计比较危险，因为同样的公式也可以有许多种不同的写法。电脑比较不是人脑。

20wangz · 发表于 2009-5-19 21:27

关于公式编辑器的使用技巧和TeX代码在WORD公式编辑中的应用，我在Office精英俱乐部回答了很多问题了，也发了一个示范性的帖子，完全原创的，可惜居然连一个顶的人都没有，让我失望。

在这里再转一下那个帖子的地址吧，希望能在同好见赏。

题目是《将 Mathematica 推导出来的公式直接导入 WORD 文件的方法》。
http://www.officefans.net/cdb/viewthread.php?tid=104467

小fisher · 发表于 2009-5-20 18:14

把下面这个代码复制到标准模块中，然后运行ShowEqText()过程，可以在立即窗口中输出ThisDocument中所有公式中包含的文本，不同公式之间有“-----”隔开

'内存函数
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'剪贴板函数
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Const CF_ENHMETAFILE = 14
'设备上下文函数
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'增强图元文件函数
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hEmf As Long) As Long
Private Declare Function EnumEnhMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hEmf As Long, ByVal lpEnhMetaFunc As Long, lpData As Any, lpRect As RECT) As Long
Private Type ENHMETARECORD
itype As Long
nSize As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const EMR_EXTTEXTOUTA = 83
Private Const EMR_EXTTEXTOUTW = 84
Sub ShowEqText()
Dim hMem As Long
Dim hEmf As Long
Dim hdc As Long
Dim hDCMem As Long
Dim oRect As RECT
Dim lRet As Long
For i = 1 To ThisDocument.InlineShapes.Count
If ThisDocument.InlineShapes(i).Field.Code.Text = " EMBED Equation.3 " Then
ThisDocument.InlineShapes(i).Field.Copy
If OpenClipboard(ByVal 0&) Then
hMem = GetClipboardData(CF_ENHMETAFILE)
If CBool(hMem) Then
hEmf = CopyEnhMetaFile(hMem, vbNullString)
End If
CloseClipboard
End If
If hEmf <> 0 Then
hdc = GetDC(0)
hDCMem = CreateCompatibleDC(hdc)
ReleaseDC 0, hdc
With oRect
.Left = 0
.Top = 0
.Right = 1
.Bottom = 1
End With
Dim s As String
lRet = EnumEnhMetaFile(hDCMem, hEmf, AddressOf EnhMetaFileProc, s, oRect)
DeleteEnhMetaFile hEmf
DeleteDC hDCMem
Debug.Print "----------"
End If
End If
Next
End Sub
Private Function EnhMetaFileProc(ByVal hdc As Long, ByVal lpHTable As Long, ByVal lpEMFR As Long, ByVal nObj As Long, lParam As String) As Long
Dim nSize As Long
Dim bytStr() As Byte
Dim itype As Long
Dim s As String
Dim iASC As Integer
CopyMemory itype, ByVal lpEMFR, 4
If itype = EMR_EXTTEXTOUTW Then
CopyMemory nSize, ByVal lpEMFR + 72, 4
nSize = nSize - 76
ReDim bytStr(1 To nSize) As Byte
CopyMemory bytStr(1), ByVal lpEMFR + 76, nSize
For i = 1 To nSize Step 2
CopyMemory iASC, bytStr(i), 2
s = s & ChrW(iASC)
Next
Debug.Print s
ElseIf itype = EMR_EXTTEXTOUTA Then
CopyMemory nSize, ByVal lpEMFR + 72, 4
nSize = nSize - 76
ReDim bytStr(1 To nSize) As Byte
CopyMemory bytStr(1), ByVal lpEMFR + 76, nSize
For i = 1 To nSize Step 2
CopyMemory iASC, bytStr(i), 2
s = s & Chr(iASC)
Next
End If
EnhMetaFileProc = 1
End Function

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 如何查找公式编辑器编写的内容(vba也好)

fisher兄果然高见