VBA to insert before and after superscript and subscript in MSWord

Question

I am trying to create VBA to insert before and after Supercript and subscript. My code is below.

Public Sub MySubscriptSuperscript() 
Dim myRange As Word.Range, myChr 
For Each myRange In ActiveDocument.StoryRanges  
Do     
     For Each myChr In myRange.Characters 
     If myChr.Font.Superscript = True Then
        myChr.Font.Superscript = False
        myChr.InsertBefore "<sup>"
        myChr.InsertAfter "</sup>"
    End If  

    If myChr.Font.Subscript = True Then
        myChr.Font.Subscript = False
        myChr.InsertBefore "<sub>"
        myChr.InsertAfter "</sub>"
    End If
Next
Set myRange = myRange.NextStoryRange
Loop Until myRange Is Nothing   
Next 
End Sub

This code is working good for each character of superscript and subscript.

But, I am looking for VBA which insert tags before and after complete superscript/subscript word/letters.

Example

C₁₂H₂₂O₁₁ and x²³ + y³⁹⁷ + x⁶⁷

Above VBA is giving following Output

C<sub>1</sub><sub>2</sub>H<sub>2</sub><sub>2</sub>O<sub>1</sub><sub>1</sub><sub> </sub><sub> </sub> and x<sup>2</sup><sup>3</sup> + y<sup>3</sup><sup>9</sup><sup>7</sup> + x<sup>6</sup><sup>7</sup>

But I am looking for this output

C<sub>12</sub>H<sub>22</sub>O<sub>11</sub> and x<sup>23</sup> + y<sup>397</sup> + x<sup>67</sup>

Pls guide, how this can be achieved.

majka · Accepted Answer · 2019-02-02 17:11:55Z

1

I would be tempted to go for easiest way to get the end result - at the end, simply do a replace of </sub><sub> and </sup><sup> with an empty string "".

But then, I am lazy this way...

Edit - just an idea: wouldn't it be faster to do the whole thing with replace? You wouldn't have to check every character. Here is what Word does record for the replacement, it would need a bit of polishing:

    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = False
    End With
    With Selection.Find
        .Text = "^?"
        .Replacement.Text = "<sup>^&</sup>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

So, at the end, you would run search&replace 4 times:

replace superscript
delete the closing and opening tags for superscript
replace subscript
delete the closing and opening tags for subscript

edited Feb 2, 2019 at 17:11

answered Feb 2, 2019 at 16:52

majka

415 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

majka Over a year ago

Just to be clear, I mean to do it with vba, so that you get the result you want with the macro.

macropod · Accepted Answer · 2019-02-03 06:54:11Z

0

Try:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Text = ""
    .Wrap = wdFindContinue
    .Font.Subscript = True
    .Replacement.Text = "<sub>^&<\sub>"
    .Execute Replace:=wdReplaceAll
    .Font.Superscript = True
    .Replacement.Text = "<sup>^&<\sup>"
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

It's not apparent why you'd be looping through all storyranges, as such content would ordinarily only be in the document body. That said, it's easy enough to modify the code to work with all storyranges.

answered Feb 3, 2019 at 6:54

macropod

14k2 gold badges11 silver badges25 bronze badges

Collectives™ on Stack Overflow

VBA to insert before and after superscript and subscript in MSWord

2 Answers 2

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related