Excelで添え字を簡単に入力するアドイン

Excelで化学式や数式を入力するとき、下付き文字や上付き文字を入力したくなることがあります。
ところが、Excelではこうした添え字を設定するのは一苦労です。
なんとか楽に入力する方法はないかとGoogle先生に聞いたところ、あるブログを紹介されました。
DeltaTECH: Excelで下付き文字と上付き文字をLatex風に入力できるマクロ作ってみた。
実際に使ってみて、とても便利でした。
この素晴らしいマクロの機能を一歩発展させて、セルに入力したら自動で添え字に変換する方法はないか。
いろいろ検索をかけて使えそうなコードをかき集め、ついに完成しました。
アドインにしたので、ご利用ください。
ダウンロードはこちらから。
画面上部の「フォルダーの操作」をクリックし、表れたメニューの「フォルダーのダウンロード」をクリックするとダウンロードできます。

使い方
・このアドインをダブルクリックして開けば、準備完了です。
・下付きにするには　_{下付き文字}
・上付きにするには　^{上付き文字}
と入力して、Enterを押してセルの入力を確定すると、自動で変換されます。
例えば、NO3-はNO_{3}^{-}と入力すれば、変換できます。



この場にて、マクロ開発者のSEFFR-9様にお礼を申し上げます。




以下、ソースコード

'ThisWorkbookに書き込む。

Option Explicit
Private WithEvents xlApp As Application

Private Sub Workbook_Open()
Set xlApp = Application
End Sub

Private Sub workbook_BeforeClose(Cancel As Boolean)
Set xlApp = Nothing
End Sub
'以上、アドインでもイベントプロシージャを使えるようにする命令
'参考：http://okwave.jp/qa/q2649739.html


Private Sub xlApp_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'コードの出典： DeltaTECH http://deltatech.blog90.fc2.com/blog-entry-364.html

'正規表現　http://msdn.microsoft.com/ja-jp/library/ms974570.aspx
'イベントプロシージャ　http://excelvba.pc-users.net/fol3/3_6.html
'高速化　http://officetanaka.net/excel/vba/speed/index.htm
'Likeの使い方　http://officetanaka.net/excel/vba/tips/tips35.htm
'（参考）速度計測　http://www.sanryu.net/acc/tips/tips278.htm

'既知のバグ：　H_{2}Oと入力すると、Oが消える。H_{2}O_{2}は問題なく動作する。

'下付き上付きにするときだけ正規表現を呼び出す。
If Target.Value Like "*_{?*}*" Or Target.Value Like "*^{?*}*" Then

'画面表示OFF
Application.ScreenUpdating = False

'変数の宣言
Dim RE1 As Object, RE2 As Object
Dim reMatch1 As Object, reMatch2 As Object
Dim strPatternSub As String, strPatternSuper As String
Dim i As Integer, m As Integer, Sum As Integer
Dim j(100) As Long, k As Long, l(100, 2) As Long
Dim msg As String, msg2 As String

'下付き文字
Set RE1 = CreateObject("VBScript.RegExp")
strPatternSub = "\_\{.+?(?=\})"
With RE1
.Pattern = strPatternSub
.IgnoreCase = True
.Global = True
Set reMatch1 = .Execute(Target)
msg = ""
If reMatch1.Count > 0 Then
k = 1
For i = 0 To reMatch1.Count - 1
j(i) = Len(reMatch1(i).Value)
msg = msg & Mid$(Target.Value, k, reMatch1(i).FirstIndex - k + 1) & Mid$(reMatch1(i).Value, 3, j(i) - 2)
k = reMatch1(i).FirstIndex + j(i) + 2
Next i
If k < Len(Target.Value) Then
msg = msg & Mid$(Target.Value, k, Len(Target.Value) - k + 1)
End If
Else: msg = Target.Value
End If
End With

'下付き文字の文字列位置情報の退避
Sum = 1
For i = 0 To reMatch1.Count - 1
j(i) = Len(reMatch1(i).Value)
l(i, 0) = reMatch1(i).FirstIndex - i * 3 + 1 '下付き文字のはじまり
l(i, 1) = j(i) - 2 '下付き文字の長さ
Next i

'上付き文字
Set RE2 = CreateObject("VBScript.RegExp")
strPatternSuper = "^{.+?(?=})"
With RE2
.Pattern = strPatternSuper
.IgnoreCase = True
.Global = True
Set reMatch2 = .Execute(msg)
msg2 = ""
If reMatch2.Count > 0 Then
k = 1
For i = 0 To reMatch2.Count - 1
j(i) = Len(reMatch2(i).Value)
msg2 = msg2 & Mid$(msg, k, reMatch2(i).FirstIndex - k + 1) & Mid$(reMatch2(i).Value, 3, j(i) - 2)
k = reMatch2(i).FirstIndex + j(i) + 2

For m = 0 To reMatch1.Count - 1 '下付き文字の調整
If k < l(m, 0) Then
l(m, 0) = l(m, 0) - 3
End If
Next m

Next i
If k < Len(msg) Then
msg2 = msg2 & Mid$(msg, k, Len(msg) - k + 1)
End If
Else: msg2 = msg
End If
End With

'文字列の置換
Target.Value = msg2

'上付き文字フォントへの置換
For i = 0 To reMatch2.Count - 1
j(i) = Len(reMatch2(i).Value)
Target.Characters(Start:=reMatch2(i).FirstIndex - i * 3 + 1, Length:=j(i) - 2).Font.Superscript = True
Next i

'下付き文字フォントへの置換
For i = 0 To reMatch1.Count - 1
Target.Characters(Start:=l(i, 0), Length:=l(i, 1)).Font.Subscript = True
Next i

'ゴミ捨て
Set reMatch1 = Nothing
Set RE1 = Nothing
Set reMatch2 = Nothing
Set RE2 = Nothing

'画面表示ON
Application.ScreenUpdating = True

End If

End Sub