Сначала я хотел основать решение на регулярных выражениях. Написать такое выражение не имеет большого значения, но Superscript - это свойство. Невозможно заменить свойство другим, используя регулярное выражение. Вместо RegExp.Replace можно использовать RegExp.Execute, который находит все вхождения, но этот метод не сохраняет информацию о позиции и длине каждого вхождения.
Вместо регулярных выражений я просто использовал цикл для перебора всего текста.
Сначала код определяет, что нужно изменить, а во втором цикле применяет изменения. Это делается в соответствии со ссылкой msdn « На панели окна документа может быть только один объект Selection, и только один объект Selection во всем приложении может быть активным. »
Option Explicit
Sub toSuperscript()
Dim al As String
Dim alPosition As Integer
Dim alOcc As String 'Al occurence
Dim strTemp As String
Dim strTemp_len As Integer
Dim counter As Integer
Dim subCounter As Integer
Dim c As New Collection 'start
Dim c1 As New Collection 'length
al = "Al" 'the searched string
ActiveDocument.Select
strTemp = Selection.Text
strTemp_len = Len(strTemp)
'search for Al
For counter = 1 To strTemp_len
alOcc = Mid(strTemp, counter, 2) '2 as Al is characters long
If StrComp(CStr(alOcc), CStr(al), vbBinaryCompare) = 0 Then
subCounter = 0
Do Until IsNumeric(Mid(strTemp, counter + 2, subCounter + 1)) = False
subCounter = subCounter + 1
Loop
c.Add CStr(counter + 2) 'start
c1.Add CStr(subCounter) 'length
End If
Next counter
'Apply superscript
For counter = 1 To c.Count
ActiveDocument.Range(Start:=c.Item(counter) - 1, End:=CInt(c.Item(counter)) + CInt(c1.Item(counter)) - 1).Font.superscript = True
Next counter
Application.Selection.StartOf 'Put the cursor at the beginning of the document (optional)
End Sub