Excel 2010 宏的下标/上标热键？

Question

背景

在 Excel 2010 中，出于某种荒谬的原因，没有用于在文本单元格中添加下标/上标文本的内置热键（甚至工具栏上的按钮）。

但是，您可以突出显示文本，右键单击所选内容，单击format，然后选中[x] subscript或[x] superscript复选框。

题

是否有任何类型的 excel 宏或解决方法可以将两个键盘热键分别映射到下标和上标键？

（它应该只有两行代码 - 一行用于事件处理程序，另一行用于实际过程调用......我会自己编写一行，但我的 VBA 充其量是生疏的，我非常有信心可能已经有了某种解决方案，尽管我无法通过搜索引擎找到一个）

感谢您的任何帮助，您可以提供！

Answer 1

我通常保存我从中获得这些的网站，但我从很久以前的论坛中获取了大部分代码......我建议将此宏设置为热键。顶部的评论应该是不言自明的

    Sub Super_Sub()
'
' Keyboard Shortcut: Ctrl+Shift+D
'
' If the characters are surrounded by "<" & ">" then they will be subscripted
' If the characters are surrounded by "{" & "}" then they will be superscripted
'
Dim NumSub
Dim NumSuper
Dim SubL
Dim SubR
Dim SuperL
Dim SuperR
Dim CheckSub, CheckSuper as Boolean
Dim CounterSub, CounterSuper as Integer
Dim aCell, CurrSelection As Range

For Each c In Selection
c.Select

CheckSub = True
CounterSub = 0
CheckSuper = True
CounterSuper = 0
aCell = ActiveCell
'
NumSub = Len(aCell) - Len(Application.WorksheetFunction.Substitute(aCell, "<", ""))
    NumSuper = Len(aCell) - Len(Application.WorksheetFunction.Substitute(aCell, "{", ""))
'
If Len(aCell) = 0 Then Exit Sub
If IsError(Application.Find("<", ActiveCell, 1)) = False Then
Do
    Do While CounterSub <= 1000
        SubL = Application.Find("<", ActiveCell, 1)
        SubR = Application.Find(">", ActiveCell, 1)
        ActiveCell.Characters(SubL, 1).Delete
        ActiveCell.Characters(SubR - 1, 1).Delete
        ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
        CounterSub = CounterSub + 1
        If CounterSub = NumSub Then
            CheckSub = False
        Exit Do
        End If
    Loop
Loop Until CheckSub = False
End If
'
'
If IsError(Application.Find("{", ActiveCell, 1)) = False Then
Do
    Do While CounterSuper <= 1000
        SuperL = Application.Find("{", ActiveCell, 1)
        SuperR = Application.Find("}", ActiveCell, 1)
        ActiveCell.Characters(SuperL, 1).Delete
        ActiveCell.Characters(SuperR - 1, 1).Delete
        ActiveCell.Characters(SuperL, SuperR - SuperL - 1).Font.Superscript = True
        CounterSuper = CounterSuper + 1
        If CounterSuper = NumSuper Then
            CheckSuper = False
            Exit Do
        End If
    Loop
Loop Until CheckSuper = False
End If
'
Next

End Sub