Here are a few short macros that create an in-cell editor specifically for doing super and subscripting. Just copy the code below into a text file ending in .BAS, open the VB editor (Alt-F11), right-click "Modules" in the project tree, and select import file. Add quick access to SuperSubTop() using a button or keystroke and enjoy!'SuperSub -- an in-cell editor to do superscript and subscript easily
'To install: put this code in a module in your personal workbook (Alt-F11 to open code window)
'Run SuperSubTop when cell to be edited is selected (add to toolbar, keystroke activate, etc.)
'Right/left arrow keys move cursor (underline character)
'Up/Down arrow keys make character at cursor superscript/subscript
'Enter exits routine and returns keys to normal
'
'Version 1.0
'Author: Patrick Wiegand
'Company: Rock Lake Software (RockLakeSoftware.com)
'Release date: 9/23/09
'License: Free for personal use, re-distribution not allowed unless free
'Disclaimer: The author is not responsible for use or misuse of this software.
' USE AT YOUR OWN RISK
'*** Anonomyously do a good deed today and be civil to those of differing viewpoints... --Pat ***Private charpos As Integer, curcol As Integer, currow As Integer
Sub SuperSubTop()
'temporarily re-define some keys
Application.OnKey "{Down}", "DoDown"
Application.OnKey "{Up}", "DoUp"
Application.OnKey "{Left}", "DoLeft"
Application.OnKey "{Right}", "DoRight"
Application.OnKey "{Enter}", "DoEnter"
Application.OnKey "~", "DoEnter"
Beep
'next IF allows re-running this routine after selecting a different cell without hitting enter
If ActiveCell.Row <> currow Or ActiveCell.Column <> curcol Then
charpos = 1
ActiveCell.Characters(charpos, 1).Font.Underline = True
currow = ActiveCell.Row
curcol = ActiveCell.Column
End If
'Warning -- shameless self-promotion on next line!
Application.StatusBar = "Rock Lake Software's SuperSub in-cell editing activated. Enter to exit, arrow keys to edit/move."
End Sub
Private Sub DoEnter()
'the exit routine. Returns keys to their original use
Application.OnKey "{Down}"
Application.OnKey "{Up}"
Application.OnKey "{Left}"
Application.OnKey "{Right}"
Application.OnKey "{Enter}"
Application.OnKey "~"
Cells(currow, curcol).Characters(charpos, 1).Font.Underline = False
'Oh No! More shameless self-promotion
Application.StatusBar = "Rock Lake Software's SuperSub routine ended. Keys returned to normal usage."
Beep
End Sub
Private Sub DoRight()
'move cursor to the right. Next if will run exit routine if user forgot and selected another cell with mouse.
If ActiveCell.Row <> currow Or ActiveCell.Column <> curcol Then
DoEnter
Exit Sub
End If
If Len(ActiveCell.Text) > charpos Then
charpos = charpos + 1
ActiveCell.Characters(charpos - 1, 1).Font.Underline = False
ActiveCell.Characters(charpos, 1).Font.Underline = True
End If
End Sub
Private Sub DoLeft()
'move cursor to the left
If ActiveCell.Row <> currow Or ActiveCell.Column <> curcol Then
DoEnter
Exit Sub
End If
If charpos > 1 Then
charpos = charpos - 1
ActiveCell.Characters(charpos + 1, 1).Font.Underline = False
ActiveCell.Characters(charpos, 1).Font.Underline = True
End If
End Sub
Private Sub DoUp()
'make current character above cursor superscripted if normal or normal if subscripted
If ActiveCell.Row <> currow Or ActiveCell.Column <> curcol Then
DoEnter
Exit Sub
End If
'Wierdness next few lines. Not sure why you can't just set subscript to false...
If ActiveCell.Characters(charpos, 1).Font.Subscript = True Then
ActiveCell.Characters(charpos, 1).Font.Superscript = True
ActiveCell.Characters(charpos, 1).Font.Superscript = False
Else
ActiveCell.Characters(charpos, 1).Font.Superscript = True
End If
End Sub
Private Sub DoDown()
'make current character above cursor subscripted if normal or normal if superscripted
If ActiveCell.Row <> currow Or ActiveCell.Column <> curcol Then
DoEnter
Exit Sub
End If
If ActiveCell.Characters(charpos, 1).Font.Superscript = True Then
ActiveCell.Characters(charpos, 1).Font.Superscript = False
Else
ActiveCell.Characters(charpos, 1).Font.Subscript = True
End If
End Sub
