☰

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

tag-icon • tag-icon microsoft-excel macros microsoft-excel-2010 vba
Excel 2010 宏的下标/上标热键？

背景

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

你能但是，突出显示文本，右键单击选择，单击format，然后选中[x] subscript或[x] superscript复选框。

问题

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

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

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

答案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

答案2

我刚刚添加了 ScottS 提供的代码，因此可以使用“^”或“_”作为字符前缀。请注意，如果使用这些字符，则所有后续字符都将被下标/上标。例如，Q_in (m^3/s) 将无法正确显示，您需要使用 ScottS 的语法来实现这一点：Q< in> (m{3}/s)。此处的代码适用于 ScottS 的语法，但也包括“_”和“^”选项，例如 Q_in 或 Q_supply gas，其中“supply gas”带有下标。

对于不熟悉宏的人：如果您的 Excel 中没有“开发人员”选项卡，则需要启用它并将工作表保存为启用宏的工作表。Office 按钮（左上角的圆形按钮）> 单击右下角的“Excel 选项”> 查看“常用”选项卡，选中“在功能区中显示开发人员选项卡”

然后您需要添加此宏：“Alt+F11”，然后“插入”>“模块”，并粘贴以下代码。您可以在查看电子表格时按“Alt+F8”或单击“开发人员”选项卡中的“宏”按钮来设置键盘快捷键。选择/突出显示此宏（Super_Sub_mod）并单击“选项...”，在这里您可以设置以“Ctrl”开头的快捷方式，例如“Ctrl+j”，只需在框中输入“j”即可。

更改不会因为语法正确而自动进行。您必须在使用“_”“^”“{text}”“<text>”语法写入单元格后选择单个或多个单元格，然后运行宏。

    Sub Super_Sub_mod()
'
' Keyboard Shortcut: set in "options" of macro window (alt+F8 in spreadsheet view)
'
' If the characters are preceded by an underscore "_" then they will be subscripted
' If the characters are preceded 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
'

'Subscripts
'all following "_"
If Len(aCell) = 0 Then Exit Sub
If IsError(Application.Find("_", ActiveCell, 1)) = False Then
NumSub = Len(aCell) - Len(Application.WorksheetFunction.Substitute(aCell, "_", ""))
Do
    Do While CounterSub <= 1000
        SubL = Application.Find("_", ActiveCell, 1)
        SubR = Len(ActiveCell)
        ActiveCell.Characters(SubL, 1).Delete
        ActiveCell.Characters(SubL, SubR - SubL).Font.subscript = True
        CounterSub = CounterSub + 1
        If CounterSub = NumSub Then
            CheckSub = False
        Exit Do
        End If
    Loop
Loop Until CheckSub = False
End If
'select region "<text>"
If IsError(Application.Find("<", ActiveCell, 1)) = False Then
NumSub = Len(aCell) - Len(Application.WorksheetFunction.Substitute(aCell, "<", ""))
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
'
'Superscripts
'all following "_"
If IsError(Application.Find("^", ActiveCell, 1)) = False Then
NumSuper = Len(aCell) - Len(Application.WorksheetFunction.Substitute(aCell, "^", ""))
Do
    Do While CounterSuper <= 1000
        SuperL = Application.Find("^", ActiveCell, 1)
        ActiveCell.Characters(SuperL, 1).Delete
        ActiveCell.Characters(SuperL, SuperR - SuperL).Font.Superscript = True
        CounterSuper = CounterSuper + 1
        If CounterSuper = NumSuper Then
            CheckSuper = False
            Exit Do
        End If
    Loop
Loop Until CheckSuper = False
End If
'select region "{text}"
If IsError(Application.Find("{", ActiveCell, 1)) = False Then
NumSuper = Len(aCell) - Len(Application.WorksheetFunction.Substitute(aCell, "{", ""))
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

答案3

假设您想要突出显示单元格内的文本，而不仅仅是选定的文本，请使用您想要的任何热键和以下 VBA 创建一个宏：

ActiveCell.Font.Superscript = True

答案4

以下是一些适用于在您想要上标或下标的任何字符前添加“^”或“_”的代码。这将仅对“^”或“_”后面的一个字符进行上标或下标，我发现这比在两侧添加括号更省时。只是想分享一下！:)

Sub sscript()
'
' sscript Macro
'
' Keyboard Shortcut: Ctrl+Shift+G
'
' 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 = InStr(1, ActiveCell, "_", vbTextCompare)
        SubR = InStr(1, ActiveCell, "_", vbTextCompare) + 1
        ActiveCell.Characters(SubL, 1).Delete
        ActiveCell.Characters(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 = InStr(1, ActiveCell, "^", vbTextCompare)
        SuperR = InStr(1, ActiveCell, "^", vbTextCompare) + 1
        ActiveCell.Characters(SuperL, 1).Delete
        ActiveCell.Characters(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

相关内容