write a standard enthalpy change sign

My wife, Lana Rude, used to spend ages calling up a delta sign then fiddling about getting a standard sign by superscripting a o and scoring a line through it. So I wrote a macro which adds the standard enthalpy sign below:

The r is lowered by 1 point and the standard sign is the Greek capital letter theta, Unicode symbol 03F4, also known as HTML entity 1012. This is superscripted, raised by 3 points and made font 8.

Sub DeltaHStandard()

'add delta sign
Selection.InsertSymbol Font:="Arial", CharacterNumber:=916, Unicode:=True

'switch to subscript and add r
Selection.Font.Subscript = wdToggle
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Position = -1
    End With
Selection.TypeText Text:="r"

'switch back from subscript and add H
Selection.Font.Subscript = wdToggle
With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Position = 0
    End With
Selection.TypeText Text:="H"
    
'switch to superscript and add standard sign
Selection.Font.Superscript = wdToggle
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Position = 3
    End With
Selection.InsertSymbol Font:="Arial", CharacterNumber:=1012, Unicode:=True
    
'switch back from superscript and add a space
Selection.Font.Superscript = wdToggle
Selection.Font.Size = 11
With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Position = 0
End With
Selection.TypeText Text:=" "
    
End Sub

write a sulfate ion with 2- above the 4

Use the macro below to write a sulfate ion like this:

The font is Arial size 11, unlike the font produced by Equations using the method here. Put the macro on the Quick Access Toolbar then type 21 for the sulfate ion, 22 for nitrate and 23 for carbonate.

Sub SymbolsByBigAl()
'make popup box
10 Dim Message, Title, MyValue
Message = "enter the atomic number (1-20 only)" & Chr(13) & Chr(10) & "21 = sulfate" _
& Chr(13) & Chr(10) & "22 = nitrate" & Chr(13) & Chr(10) & "23 = carbonate"
Title = "Big Al's symbol generator"

'deal with inputs
MyValue = InputBox(Message, Title, MyValue)
If MyValue = 1 Then GoTo 100
If MyValue = 2 Then GoTo 200
If MyValue = 3 Then GoTo 300
If MyValue = 4 Then GoTo 400
If MyValue = 5 Then GoTo 500
If MyValue = 6 Then GoTo 600
If MyValue = 7 Then GoTo 700
If MyValue = 8 Then GoTo 800
If MyValue = 9 Then GoTo 900
If MyValue = 10 Then GoTo 1000
If MyValue = 11 Then GoTo 1100
If MyValue = 12 Then GoTo 1200
If MyValue = 13 Then GoTo 1300
If MyValue = 14 Then GoTo 1400
If MyValue = 15 Then GoTo 1500
If MyValue = 16 Then GoTo 1600
If MyValue = 17 Then GoTo 1700
If MyValue = 18 Then GoTo 1800
If MyValue = 19 Then GoTo 1900
If MyValue = 20 Then GoTo 2000
If MyValue = 21 Then GoTo 2100
If MyValue = 22 Then GoTo 2200
If MyValue = 23 Then GoTo 2300
If MyValue = "" Then GoTo 5000


'deal with wrong inputs
BeepMsg "you were told to choose 1 to 23, numpty"
GoTo 10

'write symbols
100 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="1"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="1"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="H"
GoTo 5000

200 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="2"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="4"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="He"
GoTo 5000

300 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="3"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="7"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Li"
GoTo 5000

400 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="4"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="9"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Be"
GoTo 5000

500 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="5"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="11"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="B"
GoTo 5000

600 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="6"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="12"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="C"
GoTo 5000

700 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="7"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="14"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="N"
GoTo 5000

800 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="8"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="16"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="O"
GoTo 5000

900 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="9"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="19"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="F"
GoTo 5000

1000 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="10"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="20"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Ne"
GoTo 5000

1100 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="11"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="23"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Na"
GoTo 5000

1200 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="12"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="24"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Mg"
GoTo 5000

1300 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="13"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="27"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Al"
GoTo 5000

1400 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="14"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="28"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Si"
GoTo 5000

1500 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="15"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="31"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="P"
GoTo 5000

1600 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="16"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="32"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="S"
GoTo 5000

1700 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="17"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="35"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Cl"
GoTo 5000

1800 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="18"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="40"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Ar"
GoTo 5000

1900 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="19"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="39"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="K"
GoTo 5000

2000 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="20"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="40"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Ca"
GoTo 5000

2100 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add(Selection.Range, _
        wdOMathFunctionScrSubSup).ScrSubSup.AlignScripts = False
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="SO"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="4"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="2-"
GoTo 5000
   
2200 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add(Selection.Range, _
        wdOMathFunctionScrSubSup).ScrSubSup.AlignScripts = False
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="NO"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="3"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="-"
GoTo 5000

2300 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add(Selection.Range, _
        wdOMathFunctionScrSubSup).ScrSubSup.AlignScripts = False
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="CO"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="3"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="2-"
GoTo 5000

5000

'sort out italics and font
Dim equation As OMath
For Each equation In ActiveDocument.OMaths
        equation.Range.Font.Italic = False
Next equation

Selection.WholeStory
    Selection.Font.Name = "Arial"

End Sub

write E cell with a standard sign

The macro below will generate the symbol above.

Sub ECell()

Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add(Selection.Range, _
        wdOMathFunctionScrSubSup).ScrSubSup.AlignScripts = False
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="E"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="cell"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=ChrW(415)
Selection.MoveRight Unit:=wdCharacter, Count:=1
       
Dim equation As OMath
For Each equation In ActiveDocument.OMaths
        equation.Range.Font.Italic = False
Next equation
    
For Each equation In ActiveDocument.OMaths
        equation.Range.Font.Size = 12
Next equation

Selection.Font.Name = "Arial"
Selection.Font.Size = 11
Selection.TypeText Text:=" "
   
End Sub

write the symbol with mass number and atomic number

This macro will generate the symbol above in Arial font 11 rather than the Cambria Math (sic) italics which Equations produces. There is a message box asking for the atomic number (only from 1 to 20) and typing in 12 will return the symbol above.

Sub SymbolsByBigAl()
'make popup box
10 Dim Message, Title, MyValue
Message = "enter the atomic number (1-20 only)" & Chr(13) & Chr(10) & "21 = sulfate" _
& Chr(13) & Chr(10) & "22 = nitrate" & Chr(13) & Chr(10) & "23 = carbonate"
Title = "Big Al's symbol generator"

'deal with inputs
MyValue = InputBox(Message, Title, MyValue)
If MyValue = 1 Then GoTo 100
If MyValue = 2 Then GoTo 200
If MyValue = 3 Then GoTo 300
If MyValue = 4 Then GoTo 400
If MyValue = 5 Then GoTo 500
If MyValue = 6 Then GoTo 600
If MyValue = 7 Then GoTo 700
If MyValue = 8 Then GoTo 800
If MyValue = 9 Then GoTo 900
If MyValue = 10 Then GoTo 1000
If MyValue = 11 Then GoTo 1100
If MyValue = 12 Then GoTo 1200
If MyValue = 13 Then GoTo 1300
If MyValue = 14 Then GoTo 1400
If MyValue = 15 Then GoTo 1500
If MyValue = 16 Then GoTo 1600
If MyValue = 17 Then GoTo 1700
If MyValue = 18 Then GoTo 1800
If MyValue = 19 Then GoTo 1900
If MyValue = 20 Then GoTo 2000
If MyValue = 21 Then GoTo 2100
If MyValue = 22 Then GoTo 2200
If MyValue = 23 Then GoTo 2300
If MyValue = "" Then GoTo 5000


'deal with wrong inputs
BeepMsg "you were told to choose 1 to 23, numpty"
GoTo 10

'write symbols
100 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="1"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="1"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="H"
GoTo 5000

200 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="2"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="4"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="He"
GoTo 5000

300 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="3"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="7"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Li"
GoTo 5000

400 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="4"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="9"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Be"
GoTo 5000

500 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="5"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="11"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="B"
GoTo 5000

600 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="6"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="12"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="C"
GoTo 5000

700 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="7"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="14"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="N"
GoTo 5000

800 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="8"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="16"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="O"
GoTo 5000

900 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="9"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="19"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="F"
GoTo 5000

1000 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="10"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="20"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Ne"
GoTo 5000

1100 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="11"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="23"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Na"
GoTo 5000

1200 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="12"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="24"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Mg"
GoTo 5000

1300 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="13"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="27"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Al"
GoTo 5000

1400 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="14"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="28"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Si"
GoTo 5000

1500 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="15"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="31"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="P"
GoTo 5000

1600 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="16"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="32"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="S"
GoTo 5000

1700 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="17"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="35"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Cl"
GoTo 5000

1800 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="18"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="40"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Ar"
GoTo 5000

1900 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="19"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="39"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="K"
GoTo 5000

2000 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrPre
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="20"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="40"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Ca"
GoTo 5000

2100 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add(Selection.Range, _
        wdOMathFunctionScrSubSup).ScrSubSup.AlignScripts = False
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="SO"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="4"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="2-"
GoTo 5000
   
2200 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add(Selection.Range, _
        wdOMathFunctionScrSubSup).ScrSubSup.AlignScripts = False
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="NO"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="3"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="-"
GoTo 5000

2300 Selection.OMaths.Add Range:=Selection.Range
Selection.OMaths(1).Functions.Add(Selection.Range, _
        wdOMathFunctionScrSubSup).ScrSubSup.AlignScripts = False
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Selection.TypeText Text:="CO"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="3"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="2-"
GoTo 5000

5000

'sort out italics and font
Dim equation As OMath
For Each equation In ActiveDocument.OMaths
        equation.Range.Font.Italic = False
Next equation

Selection.WholeStory
    Selection.Font.Name = "Arial"

End Sub

add a science symbol

Over the years my colleague Aula Nerd used to come across useful Word symbols in other people’s documents and copy them to one central very useful document. Every time she needed an equilibrium sign or a triple bond or a radical dot or a longer minus sign she would open the afore-mentioned document, copy the symbol and use it in her new document. One day she sighed and said, ‘Where do these symbols live? How do other people find them?’

The answer is that each character has a Unicode value. If you type the Unicode (hex) value then next to it type Alt and X at the same time, the Unicode (hex) value will convert to the character.

Conversely, if you have the character in Word and next to it type Alt and X at the same time, the character will convert to the Unicode (hex) value.

I also have a macro here which will find the Unicode (decimal) value of a symbol and display it like this:

My most useful characters are:

add a triple bond sign

For many years I used to add a text box containing a single bond to a double bond which always looks messy and goes awry when the text box goes walkies. My colleague Dean Raul showed me a better way. Now I type NZZ and it Autocorrects using the method described here to a nice triple bond which looks like this:

See here for how to find the Unicode symbol for the triple bond on the keyboard.

To find the Unicode symbol of any character use my macro here.

copy selected pages to new document

If you have a long document and want to copy part of it this is a quick way. There is a message box at the start requiring the page range to copy. These pages are then copied to a new document.

Sub SelectPage()

'SelectPage Macro
Dim rCopy As Range
    Dim rCurrent As Range
    Dim sTemp As String
    Dim i As Integer
    Dim iStart As Integer
    Dim iEnd As Integer
    Set rCurrent = Selection.Range

    'Get page numbers to be copied
    sTemp = InputBox("Page range to copy (use format 6-7)", "")
    i = InStr(sTemp, "-")
    If i > 0 Then
        iStart = Val(Left(sTemp, i - 1))
        iEnd = Val(Mid(sTemp, i + 1))
        
        If iStart < 1 Then iStart = 1
        If iEnd < iStart Then iEnd = iStart
        With ActiveDocument.Range
            If iStart > .Information(wdNumberOfPagesInDocument) Then
                iStart = .Information(wdNumberOfPagesInDocument)
            End If
            If iEnd > .Information(wdNumberOfPagesInDocument) Then
                iEnd = .Information(wdNumberOfPagesInDocument)
            End If
        End With

        'Set the range
        Set rCopy = ActiveDocument.GoTo(What:=wdGoToPage, _
          Which:=wdGoToAbsolute, Count:=iStart)
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, _
          Count:=iEnd
        rCopy.End = Selection.Bookmarks("\Page").Range.End
        
        'Copy range to a new document
        rCopy.Copy
        Documents.Add
        ActiveDocument.Range.PasteSpecial
        rCurrent.Select
    Else
        If sTemp > "" Then
            MsgBox "There is no dash character"
        End If
    End If

End Sub

display bookmarks

It’s handy to see where the bookmarks are in a document but you don’t want to display them all the time. To switch them on and off do this:

File>Options>Advanced then scroll down to Show document content:

Tick or untick Show bookmarks

This all takes a bit of time so it’s better to have a macro so that you can switch display of bookmarks on or off with three clicks. If bookmarks are displayed, using the macro will turn them off. If bookmarks are not displayed, using the macro will turn them on.

Sub ToggleBookmarks()
    ActiveWindow.View.ShowBookmarks = _
      Not ActiveWindow.View.ShowBookmarks
End Sub