Solved

How to format fraction in real format in ms word file

Posted on 2004-10-22
180 Views
Last Modified: 2010-05-02
I have a macro to do this but it works only only slected string. I want to find all such strings in a document and format them. The formatting should be restricted to two digits before and 2 digits after.
The code is:
' Change point sizes to make a fraction look nice.
Sub FormatFraction()
Dim txt As String
Dim slash_pos As Long
Dim numerator As Range
Dim denominator As Range
Dim old_size As Single

    With Selection
        txt = .Text
        slash_pos = InStr(txt, "/")

        Set numerator = .Range
        numerator.End = numerator.Start + slash_pos - 1
        Do While numerator.Characters(1) = " "
            numerator.Start = numerator.Start + 1
        Loop
        old_size = numerator.Font.Size
        numerator.Font.Size = old_size * 0.6
        numerator.Font.Position = old_size * 0.3

        Set denominator = .Range
        ExcludeTrailingParagraphs denominator
        Do While _
            denominator.Characters(denominator.Characters.Count) _
            = " "
            denominator.End = denominator.End - 1
        Loop
        denominator.Start = denominator.Start + slash_pos
        denominator.Font.Size = numerator.Font.Size

        .Range.Font.Spacing = -0.5
    End With
End Sub

' Exclude any trailing empty paragraphs from the range.
Private Sub ExcludeTrailingParagraphs(ByVal rng As Range)
    Do While rng.Characters(rng.Characters.Count) = vbCr
        rng.SetRange rng.Start, rng.End - 1
    Loop
End Sub
I request expert guys to modify this macro as requested.
0
Question by:micazone
    8 Comments
     
    LVL 76

    Expert Comment

    by:GrahamSkan
    You could use wildcard searching:

    Sub FormatFraction()
    Dim txt As String
    Dim slash_pos As Long
    Dim numerator As Range
    Dim denominator As Range
    Dim old_size As Single
    Dim rng As Range

    'Initialise range objects
    Set numerator = ActiveDocument.Range
    Set denominator = ActiveDocument.Range

    Set rng = ActiveDocument.Range
        Do While True
            rng.Find.ClearFormatting
            With rng.Find.Font
                .Superscript = False
                .Subscript = False
                .Position = 0
            End With
            With rng.Find
                .Text = "[!0-9][0-9]{1,2}/[0-9]{1,2}[!0-9]"
                .Forward = True
                .Format = True
                .MatchWildcards = True
                .Execute
                If .Found = False Then
                    Exit Sub
                End If
            End With
            With rng
                txt = .Text
                slash_pos = InStr(txt, "/")
       
                numerator.Start = .Start
                numerator.End = numerator.Start + slash_pos - 1
                old_size = numerator.Font.Size
                numerator.Font.Size = old_size * 0.6
                numerator.Font.Position = old_size * 0.3
       
                denominator.Start = .Start + slash_pos
                denominator.End = .End
                denominator.Font.Size = numerator.Font.Size
       
                .Font.Spacing = -0.5
            End With
            rng.End = ActiveDocument.Range.End
        Loop
    End Sub
    0
     

    Author Comment

    by:micazone
    Thanks. Excellent.
    Is there any other way to do this. I mean by making Superscript to first digits and Subscript to last digits. because the present script changes the font scaling and position which is not acceptable in HTML.
    Thanks
    0
     
    LVL 76

    Expert Comment

    by:GrahamSkan
    That would certainly be possible in Word. I can't speak for HTML.
    0
     

    Author Comment

    by:micazone
    I have done it this way:
    Sub FormatFraction()
    Dim txt As String
    Dim slash_pos As Long
    Dim numerator As Range
    Dim denominator As Range
    Dim old_size As Single
    Dim rng As Range

    'Initialise range objects
    Set numerator = ActiveDocument.Range
    Set denominator = ActiveDocument.Range

    Set rng = ActiveDocument.Range
        Do While True
            rng.Find.ClearFormatting
            With rng.Find.Font
                .Superscript = False
                .Subscript = False
                .Position = 0
            End With
            With rng.Find
                .Text = "[!0-9][0-9]{1,2}/[0-9]{1,2}[!0-9]"
                .Forward = True
                .Format = True
                .MatchWildcards = True
                .Execute
                If .Found = False Then
                    Exit Sub
                End If
            End With
            With rng
                txt = .Text
                slash_pos = InStr(txt, "/")
                numerator.Start = .Start
                numerator.End = numerator.Start + slash_pos - 1
                old_size = numerator.Font.Size
                numerator.Font.Size = old_size - (2)
                numerator.Font.Superscript = True
                denominator.Start = .Start + slash_pos
                denominator.End = .End
                denominator.Font.Size = numerator.Font.Size
                denominator.Font.Subscript = True
            End With
            With rng.Find
                .Text = "/"
                .Replacement.Text = ChrW(8725)
                .Forward = True
                .Format = True
                .MatchWildcards = True
                .Execute Replace:=wdReplaceAll
            End With
            rng.End = ActiveDocument.Range.End
        Loop
    End Sub
    BUT THE PROBLEM IT FORMATS LEADING "," ALSO. CAN U SUGGEST POSSIBLE WAY TO EXCLUDE COMAS.
    Thanks
    0
     

    Author Comment

    by:micazone
    The " , " problem was solved by modification of
      .Text = "[!0-9][0-9]{1,2}/[0-9]{1,2}[!0-9]"
    TO
      .Text = "[0-9]{1,2}/[0-9]{1,2}"
    Now,
    Actually only 2 digits before and 2 digits after are requiried to be formated as per rules. How to restrict within this code?
    Thanks for help.
    0
     
    LVL 76

    Expert Comment

    by:GrahamSkan
    I'm sorry micazone, I thought that I'd sent the correction. I can remember typing it in, but I guess I got distracted and failed to submit it.
    Yes your modification shortened the selection, but removes the restriction on the number of digits.
    This code adjusts the range after the Find has been done.

    Sub FormatFraction()
    Dim txt As String
    Dim slash_pos As Long
    Dim numerator As Range
    Dim denominator As Range
    Dim old_size As Single
    Dim rng As Range

    'Initialise range objects
    Set numerator = ActiveDocument.Range
    Set denominator = ActiveDocument.Range

    Set rng = ActiveDocument.Range
        Do While True
            rng.Find.ClearFormatting
            With rng.Find.Font
                .Superscript = False
                .Subscript = False
                '.Position = 0 No longer necessary
            End With
            With rng.Find
                .Text = "[!0-9][0-9]{1,2}/[0-9]{1,2}[!0-9]"
                .Forward = True
                .Format = True
                .MatchWildcards = True
                .Execute
                If .Found = False Then
                    Exit Sub
                End If
            End With
            With rng
                txt = .Text
                slash_pos = InStr(txt, "/")
                numerator.Start = .Start + 1 '<-------
                numerator.End = numerator.Start + slash_pos - 1
                old_size = numerator.Font.Size
                numerator.Font.Size = old_size - (2)
                numerator.Font.Superscript = True
                denominator.Start = .Start + slash_pos
                denominator.End = .End - 1 '<---------
                denominator.Font.Size = numerator.Font.Size
                denominator.Font.Subscript = True
            End With
            With rng.Find
                .Text = "/"
                .Replacement.Text = ChrW(8725)
                .Forward = True
                .Format = True
                .MatchWildcards = True
                .Execute Replace:=wdReplaceAll
            End With
            rng.End = ActiveDocument.Range.End
        Loop
    End Sub
    0
     

    Author Comment

    by:micazone
    Every thing fine except it makes slash (/) to supercript.
    0
     
    LVL 76

    Accepted Solution

    by:
    I thought that was what chrW(8725) was doing.
    Actually, I moved numerator.start and so the next line was wrong
    Change this:
               numerator.End = numerator.Start + slash_pos - 1
    to this:
               numerator.End = numerator.Start + slash_pos - 2
    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    What Should I Do With This Threat Intelligence?

    Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

    Suggested Solutions

    Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
    Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
    Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
    Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

    933 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    18 Experts available now in Live!

    Get 1:1 Help Now