麻烦将Word方程式粘贴到Excel中

Question

我想将Word中的方程式粘贴到Excel 2007中。以下Excel VBA代码可实现此目的：

Sub ExpandEqn(MyText As String)

Dim appWd As Word.Application
Dim docWd As Word.Document
Dim objRange As Word.Range
Dim objEq As OMath

Set FindActiveCell = Application.ActiveCell
GetRange = CStr(FindActiveCell.Address())
ActiveCell.Offset(1, 0).Activate
NextActiveCell = CStr(FindActiveCell.Address())

Set appWd = CreateObject("Word.Application")
appWd.Visible = False
Set docWd = appWd.Documents.Add
Set objRange = docWd.Application.Selection.Range
objRange.Text = MyText
docWd.Application.Selection.OMaths.Add objRange
docWd.Application.Selection.OMaths.BuildUp
docWd.Application.Selection.WholeStory
docWd.Application.Selection.Copy

Range(NextActiveCell).Select
ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)",Link:=False,DisplayAsIcon:=False

appWd.Quit (False)
Set docWd = Nothing
Set appWd = Nothing

End Sub

不幸的是，粘贴的等式是具有大量空白空间的Word文档的宽度，例如

有没有办法在没有空格的情况下粘贴等式？如果将图像粘贴为位图，它可以正常工作，但我需要它作为增强的图元文件。

非常感谢和祝福。

Answer 1

好的，在我与你讨论后，我对你想要的东西有了更好的理解。我相信这应该可以解决这个问题。谢谢你的耐心等待。

Sub ExpandEqn(MyText As String)
    Dim appWd As Word.Application
    Dim docWd As Word.Document
    Dim objRange As Word.Range
    Dim objEq As OMath
    Dim FindActiveCell As Range
    Dim intColumnWidth As Integer
    Dim intRowHeight As Integer

    Set FindActiveCell = Application.ActiveCell
    GetRange = CStr(FindActiveCell.Address())
    ActiveCell.Offset(1, 0).Activate
    NextActiveCell = CStr(FindActiveCell.Address())

    Set appWd = CreateObject("Word.Application")
    appWd.Visible = False
    Set docWd = appWd.Documents.Add
    Set objRange = docWd.Application.Selection.Range
    objRange.Text = MyText
    docWd.Application.Selection.OMaths.Add objRange
    docWd.Application.Selection.OMaths.BuildUp
    docWd.Application.Selection.WholeStory
    docWd.Application.Selection.Copy

    ActiveCell.Offset(1, 0).Activate
    NextActiveCell = CStr(FindActiveCell.Address())
    Range(NextActiveCell).Select
    intColumnWidth = Range(NextActiveCell).ColumnWidth
    intRowHeight = Range(NextActiveCell).RowHeight
    docWd.Application.Selection.Columns.Width = intColumnWidth
    docWd.Application.Selection.Rows.Height = intRowHeight

    ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False

End Sub

基本上我在这里做的是在粘贴项目然后执行粘贴之前对单元格的当前宽度和高度。然后将对象粘贴到与粘贴到其中的单元格相同的大小。

Answer 2

我有一个解决方案 - 但它非常可怕：

• 在单词中创建等式并将其复制到剪贴板。
• 将其作为位图粘贴到Excel中，效果很好 - 没有多余的空间。
• 获取位图的宽度，然后将其删除。
• 返回Word，将边框调整为该宽度并重新复制等式。
• 返回Excel，粘贴为增强型图元文件

这一切都可以通过编程方式完成，但必须有更好的方法！