OMath 输出并在 Excel 中显示分数答案

【问题标题】：OMath output and display of fractions into ExcelOMath 输出并在 Excel 中显示分数
【发布时间】：2021-08-10 08:41:07
【问题描述】：

简介
使用此代码可以在 WORD 文档中显示数学方程式：

Sub genEQ()
    Dim objRange As Range
    Dim objEq As OMath
    Dim AC As OMathAutoCorrectEntry
    Application.OMathAutoCorrect.UseOutsideOMath = True
    Set objRange = Selection.Range
    objRange.Text = "Celsius = \sqrt(x+y) + sin(5/9 \times(Fahrenheit – 23 (\delta)^2))"
    For Each AC In Application.OMathAutoCorrect.Entries
        With objRange
            If InStr(.Text, AC.Name) > 0 Then
                .Text = Replace(.Text, AC.Name, AC.Value)
            End If
        End With
    Next AC
    Set objRange = Selection.OMaths.Add(objRange)
    Set objEq = objRange.OMaths(1)
    objEq.BuildUp
End Sub

使用此代码，我可以在 EXCEL 消息框中显示 UNICODE 字符而不显示“？”或“随机字符”：

Private Declare PtrSafe Function MessageBoxW Lib "User32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long

Public Function MsgBoxW(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Microsoft Excel") As VbMsgBoxResult
    MsgBoxW = MessageBoxW(Application.hWnd, StrPtr(Prompt), StrPtr(Title), Buttons)
End Function

问题

现在有没有办法将这些组合起来并在 EXCEL 的消息框中显示一个完整的公式？
进一步如何使用上面的代码 sn-p 引用 MS WORD 以在 EXCEL 中运行？
有没有办法像第一个代码的公式一样显示分数而不用“/”符号创建字符串？

【问题讨论】：

方程不是一段文字。它是一个可以将自己绘制为图片的对象。您不能在消息框中显示除文本之外的任何内容。您可以复制公式as a picture 并从那里继续使用用户表单。

标签： excel vba math ms-word equation

【解决方案1】：

正如@GSerg 所说，您需要通过中间图片并使用用户表单而不是消息框。

以下代码将文本转换为公式并通过 Publisher 保存图片，然后将其加载到预先存在的用户窗体 UserForm1 和图像占位符 Image1。我增加了字体大小以获得更好的图片分辨率，但这可以设置为其他值。

更新为使用自动更正公式

Sub DisplayFormulae()
    ' Requires reference: Microsoft Word x.x Object Library
    ' Requires reference: Microsoft Publisher x.x Object Library
    
    Dim sFormula As String: sFormula = "Celsius = \sqrt(x+y) + sin(5/9 \times(Fahrenheit – 23 (\delta)^2))"
    Dim SaveName As String: SaveName = Environ("TEMP") & "\formula.jpg"
    
    Dim AC As Word.OMathAutoCorrectEntry
    
    Dim WordDoc As New Word.Document
    With WordDoc
        .Range.Text = sFormula
        .Range.Font.Size = 18
        For Each AC In .Parent.OMathAutoCorrect.Entries
            With .Range
                If InStr(.Text, AC.Name) > 0 Then
                    .Text = Replace(.Text, AC.Name, AC.Value)
                End If
            End With
        Next AC
        .OMaths.Add(.Range).OMaths(1).BuildUp
        .OMaths(1).Range.Copy
        .Close SaveChanges:=wdDoNotSaveChanges
    End With
    
    Dim PubDoc As New Publisher.Document
    PubDoc.Pages(1).Shapes.Paste
    PubDoc.Pages(1).Shapes(1).SaveAsPicture _
        PbResolution:=pbPictureResolutionCommercialPrint_300dpi, _
        Filename:=SaveName
    PubDoc.Close
    
    UserForm1.Controls("Image1").Picture = LoadPicture(SaveName)
    UserForm1.Show
    Kill SaveName
End Sub

【讨论】：