TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
Sub BumpTheSubsAndSupers() Dim oSl As Slide Dim oSh As Shape Dim x As Long Dim dBumpBy As Double dBumpBy = 4 ' number of points to bump sub/superscript by ' Check each slide For Each oSl In ActivePresentation.Slides ' Check each shape on the slide For Each oSh In oSl.Shapes ' Make sure it's got text If oSh.HasTextFrame Then If oSh.TextFrame.HasText Then With oSh.TextFrame.TextRange For x = 1 To .Runs.Count If .Runs(x).Characters.Font.BaselineOffset <> 0 Then ' it's a sub/super; make it four points ' bigger than the text immediately prior: .Runs(x).Characters.Font.Size = _ .Runs(x - 1).Characters.Font.Size + dBumpBy End If ' it's a sub/superscript Next x End With ' textframe.textrange End If ' .HasText End If ' .HasTextFrame Next oSh ' Next oSl End Sub