3

Фон

В Excel 2010 по какой-то нелепой причине нет встроенной горячей клавиши (или даже кнопки на панели инструментов) для подписи / надстрочного текста в текстовой ячейке.

Однако вы можете выделить текст, щелкнуть правой кнопкой мыши выделенную область, выбрать формат, а затем установить флажок [x] нижний индекс или [x] верхний индекс .

Вопрос

Существуют ли какие-либо макросы Excel или обходные пути для сопоставления двух сочетаний клавиш с клавишами нижнего и верхнего индексов соответственно?

(Это должно быть только две строки кода - одна для обработчика событий и одна для фактического вызова процедуры ... Я написал бы сам, но мой VBA в лучшем случае ржавый, и я вполне уверен, что, возможно, уже есть какое-то решение, несмотря на мою неспособность найти его через поисковик)

Спасибо за любую помощь, вы можете предоставить!

4 ответа4

5

Я обычно сохраняю сайт, с которого я их получаю, но большую часть этого кода я взял с форума давным-давно ...Я предлагаю установить этот макрос на горячую клавишу. Комментарии вверху должны быть понятны

    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, где подписывается "поставляемый газ".

Для тех, кто не знаком с макросами: если у вас нет вкладки "Разработчик" в 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
0

Предполагая, что вы хотите выделить текст внутри ячейки, а не только выделенный текст, создайте макрос с любой нужной горячей клавишей и следующим VBA:

ActiveCell.Font.Superscript = True
-1

Вы не можете запустить макрос в режиме редактирования ячеек (ср. Http://social.msdn.microsoft.com/Forums/en-US/isvvba/thread/3333e18b-cef3-4d78-b47a-6916a1b2d84c/). Кроме того, нет кнопок ленты, чтобы сделать что-то подобное. Похоже, ваша единственная возможность - это утилита: http://www.panuworld.net/utils/excel/.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .