Answered by:
Is it possible to imbed superscript and subscript into a text cell in Excel using VBA?
Question

I am using decimals to properly sort numbers in Excel, but I want to display these numbers in a text cell as fractions. Example; cell F2 is .875, cell g2 is .0625; I want to convert these numbers to fractions (I have written a function to do this) and end up displaying them in cell D2 as
"7/8 x 1/16" using superscript for the numerators and subscript for the denominators. I can do this manually by selecting the numbers and formating them, but I would like to be able to concantenate the string using VBA to switch back and forth from superscript and subscript and normal font.
Answers

Hi, yes you can do this. If you record your actions you will see something like below. All you need to do is parse your text to identify which parts are numerators and which are denominators.
Range("A1").Select
ActiveCell.FormulaR1C1 = "1/16 x 7/8"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = True
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=3, Length:=2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = True
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With Marked as answer by lp48 Friday, May 29, 2009 12:02 AM

The below sub toggles the script of the range passed to it:
Public Sub ToggleScript(rng As Range)
Dim blnTop As Boolean
Dim x As LongFor Each c In rng
blnTop = True
If Len(c.Text) > 0 Then
For x = 1 To Len(c.Text)
If Mid$(c.Text, x, 1) = "/" Then blnTop = False
If ((Mid$(c.Text, x, 1) = " ") Or (Mid$(c.Text, x, 1) = "x")) Then blnTop = True
If ((Mid$(c.Text, x, 1) >= "0") And (Mid$(c.Text, x, 1) <= "9")) Then
With c.Characters(Start:=x, Length:=1).Font
Debug.Print Mid$(c.Text, x, 1), "Super "; .Superscript, "Sub "; .Subscript, blnTop
If blnTop = True Then
If .Superscript = True Then
.Superscript = False
Else
.Superscript = True
End If
Else
If .Subscript = True Then
.Superscript = False
.Subscript = False
Else
.Subscript = True
End If
End If
Debug.Print Mid$(c.Text, x, 1), "Super "; .Superscript, "Sub "; .Subscript, blnTop
End With
End If
Next
End If
Next
End Sub
Regards
ADG Marked as answer by lp48 Friday, May 29, 2009 12:02 AM
All replies

Hi, yes you can do this. If you record your actions you will see something like below. All you need to do is parse your text to identify which parts are numerators and which are denominators.
Range("A1").Select
ActiveCell.FormulaR1C1 = "1/16 x 7/8"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = True
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=3, Length:=2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = True
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With Marked as answer by lp48 Friday, May 29, 2009 12:02 AM

The below sub toggles the script of the range passed to it:
Public Sub ToggleScript(rng As Range)
Dim blnTop As Boolean
Dim x As LongFor Each c In rng
blnTop = True
If Len(c.Text) > 0 Then
For x = 1 To Len(c.Text)
If Mid$(c.Text, x, 1) = "/" Then blnTop = False
If ((Mid$(c.Text, x, 1) = " ") Or (Mid$(c.Text, x, 1) = "x")) Then blnTop = True
If ((Mid$(c.Text, x, 1) >= "0") And (Mid$(c.Text, x, 1) <= "9")) Then
With c.Characters(Start:=x, Length:=1).Font
Debug.Print Mid$(c.Text, x, 1), "Super "; .Superscript, "Sub "; .Subscript, blnTop
If blnTop = True Then
If .Superscript = True Then
.Superscript = False
Else
.Superscript = True
End If
Else
If .Subscript = True Then
.Superscript = False
.Subscript = False
Else
.Subscript = True
End If
End If
Debug.Print Mid$(c.Text, x, 1), "Super "; .Superscript, "Sub "; .Subscript, blnTop
End With
End If
Next
End If
Next
End Sub
Regards
ADG Marked as answer by lp48 Friday, May 29, 2009 12:02 AM

Thanks for the information. I was starting to figure it out, but I had moved to Office 2007 since I last did any programming and some things have changed. I really appreciate your detailed response. I'll have to change my function a bit to pass back the number of characters of the whole numbers and fractions, but the details of the font change was giving me problems.
