add powers to a maths equation

When you make an equation using Insert>Equation you can’t use superscripts to get the powers. If you try to make the powers in a smaller font it just makes the whole expression into the smaller font. My colleague Lara Dune asked me how I produce such beautiful script as:

I used to place the expression over two lines with a line drawn in. Then I found that I could dispense with the line by underlining the top line of the expression, but this went awry when underlining the powers. Inserting a maths equation looks a lot better because it straddles the line as above, but the powers are then a problem. So I use the macro below which inserts the dummy expression above with the powers raised by 3 points and in font 8, while the remainder of the equation is in font 11. Change the characters to the ones you want then run the macro here over it to convert it to Arial.

If you are producing equilibrium resources and want an expression like this:

the minus sign has to be raised by 1.3 points.

Sub MathsEquationSuperscript()

Selection.OMaths.Add Range:=Selection.Range

    Selection.OMaths(1).Functions.Add(Selection.Range, wdOMathFunctionFrac). _
        Frac.Type = wdOMathFracBar
    Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdMove
    Selection.Font.Name = "Arial"
    Selection.TypeText Text:="[P]zxz2"
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    Selection.Font.Name = "Arial"
    Selection.TypeText Text:="[Q]zxz3"
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    For Each equation In ActiveDocument.OMaths
        equation.Range.Font.Name = "Arial"
    Next equation
    For Each equation In ActiveDocument.OMaths
        equation.Range.Font.Italic = False
   Next equation
    With Selection.Find.Replacement.Font
        .Size = 8
        .Superscript = False
        .Subscript = False
        .Position = 3
    End With
    With Selection.Find
        .Text = "(zxz)([23])"
        .Replacement.Text = "\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: