Convert Numbers to Fractions Code

Here's some code I wrote that will convert any fraction entered in the form x/y to a format where the x is supersscript and the y is subscript. I am still struggling with text in VBA - is there a better way to do this?

thanks, Judy

Dim shText          As TextRange
    Dim intSlashPos     As Integer
    Dim intFracLen      As Integer
    Dim intN            As Integer
    Dim intD            As Integer
    
    Set shText = ActiveShape.Text.Selection
    
    intSlashPos = InStr(shText, "/")
    intFracLen = Len(shText)
    
    For intN = 1 To intSlashPos - 1
        shText.Characters(intN).Position = cdrSuperscriptFontPosition
    Next intN
    
    For intD = intSlashPos + 1 To intFracLen
        shText.Characters(intD).Position = cdrSubscriptFontPosition
    Next intD

Hey Judy,

Your code isn't bad, but do you have to select the text you want to convert those values to super/sub script?

Here's something I wrote for you, it will handle shapes that you select and only go through the text shapes and look for all text items with "/" in it and convert each instance like you do. The only negative thing is, if you have something like "This is my ideas/thoughts of the fraction 3/5." It will convert the "ideas/thoughts" also. If you don't want this, you can easily add some code that looks for only numbers using "IsNumeric()".

Anyway, have a look and play around with this. Notice that it will ignore fractions that are at the end of a sentence (like "Fraction 3/5." and it also handles "...?4/5 is a weird fraction." - this will stop at the question mark). Also note that it will not handle decimal-fractions i.e. "3.5/5.0". In that case, it will only convert the "5/5" portion (if you would like this changed, I'll tell you what to take out of the code...though I'm sure you can figure it out).

It also handles if a slash is at the beginning or the end of the text (so it doesn't error out).

Here's the code:

Option Explicit

Public Sub SuperSub_Scripts()
' This will take text like "34/354" and turn "34" into superscript
' and "354" and turn it into subscript
    Dim s As CorelDRAW.Shape, sr As New CorelDRAW.ShapeRange
    Dim lCharCount As Long, i As Long
    Dim lSlashPos As Long
    Dim sTemp() As String
    Dim str As String
    
    ' Leave sub if there are no shapes selected
    If ActiveSelection.Shapes.Count = 0 Then Exit Sub
    
    Set sr = ActiveSelection.Shapes.FindShapes(Type:=cdrTextShape)
    ' Make sure there are text shapes in the selection
    If sr.Count <> 0 Then
        For Each s In sr.Shapes
            lSlashPos = 1
            ' Check for '/' in text (one or more occurences)
            lSlashPos = InStr(1, s.Text.Story, "/", vbTextCompare)
            Do
                If lSlashPos > 0 Then
                    ' Format the text before and after the slash '/'
                    Call Superscript(s, lSlashPos)
                    Call Subscript(s, lSlashPos)
                End If
                lSlashPos = InStr(lSlashPos + 1, s.Text.Story, "/", vbTextCompare)
            Loop Until lSlashPos <= 0
        Next s 'In sr.Shapes
    End If 'sr.Count <> 0
End Sub

Private Sub Superscript(ByRef s As CorelDRAW.Shape, ByRef lSlashPos As Long)
' This function will use the slash position and work towards its way to the front
' of the word changing each one into superscript format until it reaches a space
' or the beginning of the word
    Dim i As Long
    
    ' First check if the slash position is the first position of the text
    ' (Hey, you never know)
    If lSlashPos = 1 Then Exit Sub
    ' Initialize i
    i = 1
    ' Loop until a space is reached or the front of the text
    Do Until (s.Text.Story.Characters(lSlashPos - i, 1).Text = " ") _
             Or (s.Text.Story.Characters(lSlashPos - i, 1).Text = "/") _
             Or (s.Text.Story.Characters(lSlashPos - i, 1).Text = ".") _
             Or (s.Text.Story.Characters(lSlashPos - i, 1).Text = "?") _
             Or (s.Text.Story.Characters(lSlashPos - i, 1).Text = "!") _
             Or (s.Text.Story.Characters(lSlashPos - i, 1).Text = vbCr) _
             Or (s.Text.Story.Characters(lSlashPos - i, 1).Text = vbLf)
        s.Text.Story.Characters(lSlashPos - i, 1).Position = cdrSuperscriptFontPosition
        i = i + 1
        ' Check if the next position is unavailable
        If ((lSlashPos - i) = 0) Then Exit Do
    Loop
End Sub

Private Sub Subscript(ByRef s As CorelDRAW.Shape, ByRef lSlashPos As Long)
' This function will use the slash position and work towards its way to the end
' of the word changing each one into superscript format until it reaches a space
' or the end of the text
    Dim i As Long
    
    ' First check if the slash position is the last position of the text
    ' (Hey, you never know)
    If lSlashPos = (s.Text.Story.Characters.Count - 1) Then Exit Sub
    ' Initialize i
    i = 1
    ' Loop until a space is reached or the end of the text
    Do Until (s.Text.Story.Characters(lSlashPos + i, 1).Text = " ") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = "/") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = ".") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = "?") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = "!") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = vbCr) _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = vbLf)
        s.Text.Story.Characters(lSlashPos + i, 1).Position = cdrSubscriptFontPosition
        i = i + 1
        ' Check if the next position is unavailable
        ' FYI Characters.Count includes (I believe) an end-of-string marker ('\0' in C)
        ' which is a character that we shouldn't account for
        If ((lSlashPos + i) = (s.Text.Story.Characters.Count)) Then Exit Do
    Loop
End Sub

Have fun! Hope this helps

P.S. Let me know what you like/dislike about the functionality.

Just as a coding thing: see where you have this bit:

Do Until (s.Text.Story.Characters(lSlashPos + i, 1).Text = " ") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = "/") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = ".") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = "?") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = "!") _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = vbCr) _
             Or (s.Text.Story.Characters(lSlashPos + i, 1).Text = vbLf)

I used to do it this way, but thought that there must be a better way; now I tend to use the InStr(IntStart,StrContains,StrChar,1) command and would probably write a small function...

Function IsEndChar(ByVal StrChr as String) as Boolean
   Dim StrEndChars as String
   StrEndChars = " /.?!" & Chr(13) & Chr(11)

   StrChr = Left(StrChr,1)

   IsEndChar=False
   If InStr(1,StrEndChars,StrChar)>0 then IsEndChar=True 

End Function

so that the Do Until becomes something like this

...StrThisChar = (s.Text.Story.Characters(lSlashPos + i, 1).Text 
   Do Until IsEndChar(StrThisChar) = True

      ...

      StrThisChar = (s.Text.Story.Characters(lSlashPos + i, 1).Text
   Loop

but you could just use the command within the code to streamline it rather than bloating the code with functions and error trapping like I've done.

Hope this helps

~Gadget~
{BTW this is just typed in so I have no idea if the code actually works }

{Edit:... thinking: if you use IsNumber() then you don't need to check for spaces or end char stuff, just make sure that the / is not at the start or end...}

Gadget,

I gotta say, I like it That's a very cool and interesting method you posted, and I'm sure I'll be using that style when I have to do something like this again.

I do like to break up a lot of things into smaller functions. So this will be perfect for that situation.

Thanks for the code, Gadget!