OMath 输出和分数显示为 Excel

OMath output and display of fractions into Excel

简介
使用此代码可以在 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

问题

  1. 在 EXCEL 中,现在有没有办法将它们组合起来并在消息框中显示完整的方程式?
    此外,如何使用上述代码片段将 MS WORD 引用为 EXCEL 内的 运行?

  2. 有没有办法像第一个代码的公式那样显示分数而不用“/”符号制作字符串?

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

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

Updated to work with autocorrect formulae

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