View Single Post
 
Old 12-28-2015, 04:49 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,501
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

FWIW, I wrote the following macro some years back - it will search the active document for all numbers preceded by a letter or a right bracket, and subscript just the numbers. Thus, C5H8(N2S)4 becomes C5H8(N2S)4, whilst 3(CaO)•2(SiO2)•4(H2O)(gel) + 3Ca(OH)2 becomes 3(CaO)•2(SiO2)•4(H2O)(gel) + 3Ca(OH)2. Unless you're working with isotopes, the results should be correct - you'll need to apply the isotope superscripting yourself (if the numbers are already superscripted, they’ll be left alone).

If your document has other alphanumeric strings in which a non-superscripted number follows a letter (eg Table cell references), you’ll need to select only the range(s) containing the text to be converted and answer ‘No’ to the prompt.
Code:
Sub ChemPwrFmt()
Application.ScreenUpdating = False
Dim oRng As Range, fRng As Range, bState As Boolean 
Select Case MsgBox("Do you want to process the whole document?", _
    vbYesNoCancel + vbQuestion, "Chemical/Power Formatter")
  Case vbYes
    bState = True
  Case vbNo
    bState = False
  Case vbCancel
    End
End Select
With Selection
  Set oRng = .Range
  With .Find
    .ClearFormatting
    .Text = "[A-Za-z)][0-9]{1,}"
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Forward = True
    Do While .Execute = True
      Set fRng = ActiveDocument.Range(Start:=Selection.Start + 1, End:=Selection.End)
      If bState = False Then
        If fRng.Start >= oRng.End Then Exit Do
        If fRng.End >= oRng.End Then fRng.End = oRng.End
      End If
      If fRng.Font.Superscript = False Then fRng.Font.Subscript = True
      fRng.Collapse Direction:=wdCollapseEnd
    Loop
  End With
End With
oRng.Select
Set fRng = Nothing: Set oRng = Nothing
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote