Вернуть строку с надстрочными символами в функции VBA

Question

У меня есть макрос в Excel, который преобразует значение десятичной степени (прямое восхождение) в астрономический часовой угол с часами (h), минутами (м) и секундами (секундами). Есть ли способ, чтобы вернуть строку с верхними аббревиатурами h, m, s?

Это мой Excel-макро:

Function Convert_Hours(Decimal_Deg) As Variant 
    With Application 
     hours_dec = Decimal_Deg/360 * 24 
     hours = Int(hours_dec) 

     minutes_dec = hours_dec - hours 
     minutes = Int(minutes_dec) 

     seconds = minutes_dec - minutes 

     Convert_Hours = " " & hours & "h " & minutes & "m " & Round(seconds, 2) & "s " 
    End With 
End Function 

Так, например, в ячейке А1 я пишу 176.7854 и в ячейке B1 =Convert_Hours(A1). Это записывает 11h 0m 0.79s в ячейку B1. Но то, что я хочу это: 11 ^{ч м} 0,79 ^s

Я не хочу, чтобы ссылаться на некоторые выбранные ячейки с помощью VBA, а затем применить что-то вроде c.Font.Superscript = True, что стандартный ответ, когда прибегая к помощи (!) для надстрочной строки в VBA. Моя функция Convert_Hours() должна возвращать отформатированную строку самостоятельно.

Спасибо заранее!

Answer 1

Поскольку строка может содержать только одиночные символы без форматирования, единственный способ добиться этого без форматирования - это найти символы Юникода, которые представляют маленькие буквы верхнего индекса.

Существует не полный блок Unicode для надстрочных латинских букв. Поэтому нам нужно забрать их из разных блоков. Обзор можно найти в Latin_script_in_Unicode.

ʰ и ˢ мы можем найти в Spacing Modifier Letters. ᵐ мы можем найти в Phonetic Extensions.

Если мы нашли символы, мы должны знать, как их конкатенировать в строку в VBA. Для этого может использоваться функция ChrW. Ему нужен десятичный код символа.

Так

... 
Convert_Hours = " " & hours & ChrW(688) & " " & minutes & ChrW(7504) & " " & Round(seconds, 2) & ChrW(738) 
... 

будет почти получить то, что вы хотите. Но размеры надстрочных букв будут разными, потому что они из разных блоков Unicode. Поэтому я предпочел бы использовать буквы по умолчанию в строке и позже форматировать их надстрочный индекс. Конечно, это невозможно сделать в рамках пользовательской функции (UDF).

---

Согласно комментарий от @arcadeprecinct

... 
Convert_Hours = " " & hours & ChrW(&H2B0) & " " & minutes & ChrW(&H1D50) & " " & Round(seconds, 2) & ChrW(&H2E2) 
... 

также будет работать с использованием шестнадцатеричной.

Answer 2

Простое предложение, которое ВСЕГДА работало для меня: (1) Перейдите на вкладку программирования и начните запись MACRO; (2) Выберите ячейку с ранее добавленной строкой; (3) Нажмите на поле формулы (верхняя часть экрана), выберите раздел строки и отметьте его как надписью; (4) Прекратите запись и посмотрите на сгенерированный код. Это покажет вам, как это делается.

Вот пример, который я только что сгенерировал:

Sub Macro1() 
    ' 
    ' Macro1 Macro 
    ' 

    ' 
     ActiveCell.FormulaR1C1 = "asd sad ads asd asd asd " 
     With ActiveCell.Characters(Start:=1, Length:=12).Font 
      .Name = "Arial" 
      .FontStyle = "Regular" 
      .Size = 11 
      .Strikethrough = False 
      .Superscript = False 
      .Subscript = False 
      .OutlineFont = False 
      .Shadow = False 
      .Underline = xlUnderlineStyleNone 
      .ThemeColor = xlThemeColorLight1 
      .TintAndShade = 0 
      .ThemeFont = xlThemeFontMinor 
     End With 
     With ActiveCell.Characters(Start:=13, Length:=7).Font 
      .Name = "Arial" 
      .FontStyle = "Bold" 
      .Size = 11 
      .Strikethrough = False 
      .Superscript = True 
      .Subscript = False 
      .OutlineFont = False 
      .Shadow = False 
      .Underline = xlUnderlineStyleNone 
      .ThemeColor = xlThemeColorLight1 
      .TintAndShade = 0 
      .ThemeFont = xlThemeFontMinor 
     End With 
     With ActiveCell.Characters(Start:=20, Length:=5).Font 
      .Name = "Arial" 
      .FontStyle = "Regular" 
      .Size = 11 
      .Strikethrough = False 
      .Superscript = False 
      .Subscript = False 
      .OutlineFont = False 
      .Shadow = False 
      .Underline = xlUnderlineStyleNone 
      .ThemeColor = xlThemeColorLight1 
      .TintAndShade = 0 
      .ThemeFont = xlThemeFontMinor 
     End With 
     Range("D4").Select 
    End Sub 

Надеется, что это помогает.