OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > Code Critique

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 15-11-2007, 17:07
JudyHNM
Guest
 
Posts: n/a
Default 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

Code:
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
Reply With Quote
  #2  
Old 05-01-2008, 14:33
Malik641
Guest
 
Posts: n/a
Default

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:
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.

Last edited by Malik641; 05-01-2008 at 14:39.
Reply With Quote
  #3  
Old 08-01-2008, 03:23
Gadget
Guest
 
Posts: n/a
Post

Just as a coding thing: see where you have this bit:
Code:
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...
Code:
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
Code:
...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...}

Last edited by Gadget; 08-01-2008 at 03:29.
Reply With Quote
  #4  
Old 08-01-2008, 07:04
Malik641
Guest
 
Posts: n/a
Default

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!
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Simple Bar code generator Webster Code Critique 2 06-09-2010 01:41
Automatically generate colour index numbers from 8-bit palet Jast New product ideas 3 07-07-2005 13:02
Converting numbers into Roman numerals Alex CorelDRAW/Corel DESIGNER VBA 0 18-02-2005 08:50
Text ENCODE Craig Tucker CorelDRAW/Corel DESIGNER VBA 10 26-01-2005 13:59
Convert barcode to curves pp21 New product ideas 1 10-03-2004 22:56


All times are GMT -5. The time now is 02:52.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com