none
Macro to Add Superscipt/Subscript RRS feed

  • Question

  • I have a cleanup macro that helps me make documents consistent. It includes "yes/no" buttons so I can make a choice since not every selection needs to be cleaned up. Now I want to have a sequence where it searches for CO2 (all caps) and make the "2" subscript (and, later, another sequence that changes the "2" in ft2 into superscript). For the life of me, I can't figure out how to write the code that select that last character and change it to superscript/subscript without changing the whole line.

    Here's the block of code I already have:

    Dim oRngCO2 As Word.Range

      Set oRngCO2 = ActiveDocument.Range

        With oRngCO2.Find

          .Text = "CO2"

          .MatchWildcards = True

          .Wrap = wdFindStop

          While .Execute

            oRngCO2.Select

            Select Case MsgBox("Subscript?", vbYesNoCancel, "FOUND " + oRngCO2)

              Case vbYes

                oRngCO2.Characters.Last = Chr(160)

              Case vbCancel

                Exit Sub

              Case Else: 'No nothing

          End Select

            oRngCO2.Collapse wdCollapseEnd

          Wend

        End With

    Please show me what tweaks I need to make so that the "2" is subscript in this instance and superscript in others. Thanks.

    Friday, April 20, 2018 4:22 PM

All replies

  • Try this:

    Sub ApplySubscript()
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Text = "CO2"
            .MatchCase = True
            .Wrap = wdFindStop
            Do While .Execute
                Select Case MsgBox("Subscript the 2?", vbQuestion + vbYesNoCancel)
                    Case vbYes
                        Selection.Characters(3).Font.Subscript = True
                    Case vbCancel
                        Exit Sub
                End Select
            Loop
        End With
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, April 20, 2018 4:31 PM
  • The following macro will search the active document for chemical formulae, and power expressions, superscripting/subscripting the numbers as appropriate. Thus, C5H8(N2S)4 becomes C<sub>5</sub>H<sub>8</sub>(N<sub>2</sub>S)<sub>4</sub>, whilst 3(CaO)•2(SiO2)•4(H2O)(gel) + 3Ca(OH)2 becomes 3(CaO)•2(SiO<sub>2</sub>)•4(H<sub>2</sub>O)(gel) + 3Ca(OH)<sub>2</sub>, and 100m2 becomes 100m<sup>2</sup>. 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 (e.g. Table cell references), you’ll need to select only the range(s) containing the text to be converted and answer ‘No’ to the prompt.

    Sub Demo()
    Application.ScreenUpdating = False
    Dim RngSel As Range, RngNum As Range, RngTmp 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
    Set RngSel = Selection.Range
    With ActiveDocument.Range
      If bState = False Then .Start = RngSel.Start
      With .Find
        .ClearFormatting
        .Text = "[A-Za-z)][0-9]{1,}"
        .MatchWildcards = True
        .Wrap = wdFindStop
        .Forward = True
        .Execute
      End With
      Do While .Find.Found = True
        Set RngNum = .Characters.Last
        If bState = False Then
          If RngNum.InRange(RngSel) = False Then Exit Do
        End If
        Set RngTmp = .Words.Last
        RngTmp.MoveStartUntil " ", wdBackward
        If LCase(RngTmp.Text) = RngTmp.Text Then
          RngNum.Font.Superscript = True
        ElseIf RngNum.Font.Superscript = False Then
          RngNum.Font.Subscript = True
        End If
        .Collapse Direction:=wdCollapseEnd
        .Find.Execute
      Loop
    End With
    RngSel.Select
    Set RngTmp = Nothing: Set RngNum = Nothing: Set RngSel = Nothing
    Application.ScreenUpdating = True
    End Sub
    Note: The display here doesn't render superscripts & subscripts properly, instead, showing them as <sup>2</sup> & <sub>2</sub>, respectively. The macro applies actual superscripts & subscripts.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Friday, April 20, 2018 10:30 PM
    Friday, April 20, 2018 10:27 PM
  • Hello J Anthony Hart,

    Has your original issue been resolved? If it has, I would suggest you mark the helpful reply as answer or provide your solution and mark as answer to close this thread. If not, please feel free to let us know your current issue.

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, April 23, 2018 5:19 AM