Перенос текста из ячейки в автофигуру

[Robespierre]

Доброго времени суток

Итак имеется текст. Переношу в автофигуру таким способом.
ActiveSheet.Shapes("Ïîëå1").Select
Selection.Characters.Text = Worksheets("Øòàìï").Range("H2").Val ue
If Worksheets("options").Range("B2").V alue = "1" Then
'в опциях настройка использовать текст по умолчанию или брать размер из ячейки.
Selection.Font.Size = Worksheets("Øòàìï").Range("H2").Fon t.Size
End If

Внезапно возникла необходимость, переносить все свойства текста в том числе надстрочность и подстрочность и тут оказывается, что вариант как с размером не прокатывает, прошу подскажите, как можно это сделать, возможно есть команда свойств текста или что-нибудь в этом роде. Поиск юзал не помогло. Хочется подобного:
Selection.Font.Superscript = Worksheets("Øòàìï").Range("H2").Fon t.Superscript

[EducatedFool]

возможно есть команда свойств текста или что-нибудь в этом роде

есть.
но придётся в цикле перебирать все символы:

Sub test()
    Dim sha As Shape: Set sha = ActiveSheet.Shapes(1)
    sha.TextFrame.Characters.Text = Range("a1").Value

    For i = 1 To Len(sha.TextFrame.Characters.Text)
      If Range("a1").Characters(i, 1).Font.Subscript Then sha.TextFrame.Characters(i, 1).Font.Subscript = True
      If Range("a1").Characters(i, 1).Font.Superscript Then sha.TextFrame.Characters(i, 1).Font.Superscript = True
    Next i
End Sub

Пример в файле: http://excelvba.ru/XL_Files/Sample__...__19-29-55.zip
(нажмите зелёную кнопочку)

[Robespierre]

Большое спасибо, все работает