Excel vba字符串变量中的上标字母

我正在寻找如何在VBA字符串变量中超级/下标字母/数字。我在excel中处理具有轴、标题和需要s脚本的图表标题的图表。此外，文本框中还有一个公式： Cpt=Cp0*e^（-ket），其中所有的p、t和0都是下标。整个表达式（-ket）上标有e（k&t之间的e）的嵌入下标。最后，所有特殊格式的字符串变量将通过剪贴板/gettext复制到PowerPoint变量

非常感谢您的帮助/指导

---

Pat K.

这只是一个解决方案，根据数据的来源和目的，代码可能对您的目的没有用处，并且可能仅被视为演示。我只将工作表上的excel单元格和文本框用作目标，而将PowerPoint文本框用作目标

简单的方法是，在将字符串从excel格式的单元格/文本框中提取到变量、字体下标、上标信息的同时，还将在并行变量中提取（此处为2D数组）。在PowerPoint中书写时可能会使用相同的字体信息。必须对演示想法进行修改/转换，以满足您的需要

演示屏幕截图

演示代码

Sub Sscript()
Dim CellStr() As Variant
Dim Rng As Range, Cell As Range
Dim shp As Shape
Dim VarNo As Long, i As Long, j As Long, Txt As String, FntInfo As String


Set Rng = Range("C3:C7")    'Range used for collecting input data and font information for the variable
VarNo = 0
    'loop used for Trial may be directly assigned to CellStr by increasing Varno by one for each cell
    For Each Cell In Rng.Cells
    VarNo = VarNo + 1
    ReDim Preserve CellStr(1 To 2, 1 To VarNo)
    Txt = Cell.Value
    CellStr(1, VarNo) = Txt
    FntInfo = ""
        For i = 1 To Len(Txt)
        If Cell.Characters(i, 1).Font.Subscript = True Then
        FntInfo = FntInfo & "A"
        ElseIf Cell.Characters(i, 1).Font.Superscript = True Then
        FntInfo = FntInfo & "B"
        Else
        FntInfo = FntInfo & "C"
        End If
        Next i
    CellStr(2, VarNo) = FntInfo
    Next Cell

    'again loop used for Trial may be directly assigned to CellStr from Textboxes in the sheet
    For Each shp In ActiveSheet.Shapes
    If shp.Type = msoTextBox Then
    VarNo = VarNo + 1
    ReDim Preserve CellStr(1 To 2, 1 To VarNo)
    Txt = shp.TextFrame2.TextRange.Text
    CellStr(1, VarNo) = Txt
    FntInfo = ""
        For i = 1 To Len(Txt)
        If shp.TextFrame2.TextRange.Characters(i, 1).Font.Subscript = msoTrue Then
        FntInfo = FntInfo & "A"
        ElseIf shp.TextFrame2.TextRange.Characters(i, 1).Font.Superscript = msoTrue Then
        FntInfo = FntInfo & "B"
        Else
        FntInfo = FntInfo & "C"
        End If
        Next i
    CellStr(2, VarNo) = FntInfo
    End If
    Next

'Start of Trial code in excel to be deleted
For i = 1 To UBound(CellStr, 2)
ActiveSheet.Cells(i, 10).Value = CellStr(1, i)
ActiveSheet.Cells(i, 11).Value = CellStr(2, i)
FntInfo = CellStr(2, i)
    For j = 1 To Len(FntInfo)
    ActiveSheet.Cells(i, 10).Characters(j, 1).Font.Subscript = False
    ActiveSheet.Cells(i, 10).Characters(j, 1).Font.Superscript = False
    If Mid(FntInfo, j, 1) = "A" Then ActiveSheet.Cells(i, 10).Characters(j, 1).Font.Subscript = True
    If Mid(FntInfo, j, 1) = "B" Then ActiveSheet.Cells(i, 10).Characters(j, 1).Font.Superscript = True
    Next j
Next
'End of Trial code in excel to be deleted


'Powerpoint placement of data in powerpoint
Dim Pp As PowerPoint.Application
Dim Prs As Presentation
Dim Sld  As Slide
Dim Pshp  As Shape

Set Pp = CreateObject("Powerpoint.application")
Pp.Visible = True
Set Prs = Pp.Presentations.Open("C:\users\user\desktop\test.pptx")
Set Sld = Prs.Slides(1)

    For i = 1 To UBound(CellStr, 2)
    Set Pshp = Sld.Shapes(i)
    Pshp.TextFrame.TextRange.Text = CellStr(1, i)
    FntInfo = CellStr(2, i)
        For j = 1 To Len(FntInfo)
        Pshp.TextFrame.TextRange.Characters(j, 1).Font.Subscript = False
        Pshp.TextFrame.TextRange.Characters(j, 1).Font.Superscript = False
        If Mid(FntInfo, j, 1) = "A" Then Pshp.TextFrame.TextRange.Characters(j, 1).Font.Subscript = True
        If Mid(FntInfo, j, 1) = "B" Then Pshp.TextFrame.TextRange.Characters(j, 1).Font.Superscript = True
        Next j
    Next

End Sub

建议添加对Microsoft PowerPoint对象库的参考，感谢您提出了一个很好的问题/挑战，以实现看似不可能但在逻辑上可能实现的目标

编辑：下面还添加了另一种更简单的方法（字符串变量的前半部分包含实际字符串，变量的后半部分包含字体信息）和通用函数

Sub Sscript2()
Dim Txt As String, Var1 As String, Var2 As String
Dim Addr As String

Var1 = GetVarFont("C6")  ' 1st half of the var contains actual string and 2nd half contain font Info
Var2 = GetVarFont("C7")  ' 1st half of the var contains actual string and 2nd half contain font Info

'Powerpoint placement of data in powerpoint
Dim Pp As PowerPoint.Application
Dim Prs As Presentation
Dim Sld  As Slide
Dim Pshp  As Object

Set Pp = CreateObject("Powerpoint.application")
Pp.Visible = True
Set Prs = Pp.Presentations.Open("C:\users\user\desktop\test.pptx")
Set Sld = Prs.Slides(1)

WriteShp Sld.Shapes(8).TextFrame.TextRange, Var1
WriteShp Sld.Shapes(9).TextFrame.TextRange, Var2
End Sub

Sub WriteShp(Ptxt As TextRange, VarX As String)
Dim i As Long
Ptxt.Text = Left(VarX, Len(VarX) / 2)
    For i = 1 To Len(VarX) / 2
    Ptxt.Characters(i, 1).Font.Subscript = False
    Ptxt.Characters(i, 1).Font.Superscript = False
    If Mid(VarX, Len(VarX) / 2 + i, 1) = "A" Then Ptxt.Characters(i, 1).Font.Subscript = True
    If Mid(VarX, Len(VarX) / 2 + i, 1) = "B" Then Ptxt.Characters(i, 1).Font.Superscript = True
    Next
End Sub

Function GetVarFont(Addr As String) As String
Dim Txt As String, i As Long
Txt = Range(Addr).Value
GetVarFont = Txt
        For i = 1 To Len(Txt)
        If Range(Addr).Characters(i, 1).Font.Subscript = True Then
        GetVarFont = GetVarFont & "A"
        ElseIf Range(Addr).Characters(i, 1).Font.Superscript = True Then
        GetVarFont = GetVarFont & "B"
        Else
        GetVarFont = GetVarFont & "C"
        End If
        Next i
End Function

---

我不确定是否可以在字符串变量中使用，但可以在将字符串分配给单元格/区域后应用sub/super脚本。请参阅：是否希望代码中的变量本身具有上标字母？好吧，那是不可能的。现在，如果要在单元格中放置文本，只需格式化字符即可。帮忙？你尝试过什么？是的，看起来VBA不会发生这种情况-除了你已经知道的例外（

Font.Superscript=True

）。字符串数据类型无法保存这些特殊的字体效果；必须从范围对象应用的。但是，您可以使用

Range.Characters

参数（开始和长度）。这可以为不必影响整个单元格的子字符串设置效果。。。底线是变量不能保持这些效果。但是一旦在一个范围对象的工作表上，就可以了。我可以得到

Cpt=Cp₀ * e^⁽⁻ᵏᵉᵗ⁾使用unicode，但p和t下标在标准字体中不可用。