web-dev-qa-db-ja.com

Excel 2010マクロの添え字/上付き文字ホットキー？

バックグラウンド

Excel 2010では、いくつかのばかげた理由により、テキストセル内のテキストを下付き/上書きするための組み込みのホットキー（またはツールバーのボタン）がありません。

あなたcanただし、テキストを強調表示し、選択範囲を右クリックして、 format、次に確認します [x] subscript または [x] superscript チェックボックス。

質問

2つのキーボードホットキーをそれぞれ下付き文字キーと上付き文字キーにマップするためのExcelマクロまたは回避策はありますか？

（たとえば、イベントハンドラー用と実際のプロシージャ呼び出し用の2行のコードのみである必要があります...自分で1つ作成しますが、VBAはせいぜい錆びており、おそらくそこにあると確信しています。検索エンジンで見つけることができなかったにもかかわらず、すでに何らかの解決策があります）

あなたが提供できるどんな助けにも感謝します！

microsoft-excelmacrosmicrosoft-excel-2010vba
3
Adam

私は通常、これらを取得したWebサイトを保存しますが、このコードの大部分は何年も前のフォーラムから取得しました...このマクロをホットキーに設定することをお勧めします。上部のコメントは自明である必要があります

    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
5
MattyB

ScottSが提供するコードに追加したので、文字の前に「^」または「_」を使用できます。これらの文字を使用すると、後続のすべての文字がサブ/スーパースクリプト化されることに注意してください。たとえば、Q_in（m ^ 3/s）は正しく表示されません。これには、ScottSの構文を使用する必要があります：Q <in>（m {3}/s）。ここのコードはScottSの構文で機能しますが、「供給ガス」が下付き文字であるQ_inやQ_supplyガスなどの「_」および「^」オプションも含まれています。

マクロに慣れていない場合：Excelに[開発者]タブがない場合は、それを有効にして、ワークシートをマクロ対応のワークシートとして保存する必要があります。 Officeボタン（左上の円形ボタン）>右下の[Excelオプション]をクリック> [人気]タブを表示する[開発者タブをリボンで表示]をオンにする

次に、次のマクロを追加する必要があります：「Alt + F11」、「挿入」>「モジュール」、以下のコードを貼り付けます。スプレッドシートの表示中に「Alt + F8」を押すか、「開発者」タブの「マクロ」ボタンをクリックして、キーボードショートカットを設定できます。このマクロ（Super_Sub_mod）を選択/ハイライトし、[オプション...]をクリックします。ここで、ボックスに「j」と入力するだけで、「Ctrl + j」などの「Ctrl」で始まるショートカットを設定できます。

適切な構文があるからといって、変更が自動的に行われるわけではありません。 "_" "^" "{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
2
user217558

選択したテキストだけでなく、セル内のテキストを強調表示する場合は、必要なホットキーと次のVBAを使用してマクロを作成します。

ActiveCell.Font.Superscript = True
1
ta.speot.is

上付き文字または下付き文字にする文字の前にある「^」または「_」に対して機能するコードを次に示します。これは、「^」または「_」に続く1文字の上付き文字または下付き文字のみであり、両側を括弧で囲むよりも時間がかからないことがわかりました。共有したいと思っただけです！ :)

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
0
Jennifer

「セル編集モード」（cfr。 http://social.msdn.Microsoft.com/Forums/en-US/isvvba/thread/3333e18b-cef3-4d78-）では、マクロを実行できません。 b47a-6916a1b2d84c / ）。また、そのようなことをするためのリボンボタンはありません。あなたの唯一のチャンスはこのユーティリティのようです： http://www.panuworld.net/utils/Excel/ 。

0
s_a