I really enjoy seeing how others choose to tackle a problem. Here is my solution. First I find only Text Shapes, Then I find only those Text Shapes that have the word H2O in them. Then I loop through the words to find the H2O and apply the Subscript to the 2. Sub SubscriptH2O() Dim srSelection As ShapeRange, srText As ShapeRange, srContains As ShapeRange Dim s As Shape Dim tr As TextRange Set srSelection = ActiveSelectionRange Set srText = srSelection.Shapes.FindShapes(Type:=cdrTextShape) Set srContains = srText.Shapes.FindShapes(Query:= "@com.text.story.text.RegContains('H2O')" ) Optimization = True For Each s In srContains For Each tr In s.Text.Story.Words If Trim(tr) = "H2O" Then tr.Characters(2).Position = cdrSubscriptFontPosition Next tr Next s Optimization = False ActiveWindow.Refresh End Sub Very fun, -Shelby
↧