need help with macro

The macro code below comes from Sub GDG_John. I modified it to find all the ® symbols and change them to "Arial" font. Works great.

I want it to change the "character position" to "superscript" instead of change the font.

Any help would be greatly appreciated.

Myron

________________________________________________

Sub ChangeFont() 'changes font of ® symbol to arial

    Dim p As Page, s As Shape, t As TextRange, sr As ShapeRange

    Dim i&, myReplaceFont$, myCharacterToFind$, j&

    myCharacterToFind = "®"

    myReplaceFont = "Arial"

    j = ActiveDocument.ActivePage.Index

    For Each p In ActiveDocument.Pages

        p.Activate

        Set sr = ActivePage.Shapes.FindShapes(, cdrTextShape)

            For Each s In sr

                For i = 1 To s.Text.Story.Characters.Count

                    Set t = s.Text.Story.Characters(i)

                    If t = myCharacterToFind Then t.Font = myReplaceFont

                Next i

        Next s

    Next p

    ActiveDocument.Pages(j).Activate

 

 

End Sub

  • Not tested, but try changing

    If t = myCharacterToFind Then t.Font = myReplaceFont t

    to

    If t = myCharacterToFind Then t.Position =cdrSuperscriptFontPosition

     

    • Thanks, unfortunately I've been trying to plug that same line at several points with no luck.

      • If I recall there was a bug that would not allow you to set Superscript, so you need to be a little sneaky. ;-) 

        Change your line:

        If t = myCharacterToFind Then t.Font = myReplaceFont

        to

        If t = myCharacterToFind Then s.Text.FontPropertiesInRange(i, 1).Position = cdrSuperscriptFontPosition

        Hope that helps,

        -Shelby

        • yep, that's it!! Damn I love smart people.

          Myron

          • Tested and proved to work with X4 & X7. Run macro and these characters (®. ™, ©)  in all text will be converted to superscript.

            Myron 

            CharacterToSuperscript.gms
            • Hello! Please help me. (sorry my english) :))
              corel X6 write me an error in string:
              t.Position =cdrSuperscriptFontPosition -
              "Run-time error '-2147024809 (80070057)':
              Value out of range. It should be in the range from 0 to 1"
              Value of the cdrSuperscriptFontPosition is 3

              t.Position =cdrSuperscriptFontPosition
              or
              s.Text.FontPropertiesInRange(i, 1).Position = cdrSuperscriptFontPosition

              too
              (as like my programm)
              Dim s As Shape
              Dim d As Document
              Set d = ActiveDocument

              For Each s In d.ActivePage.FindShapes(, cdrTextShape)

              s.Text.FontPropertiesInRange(3, 5).Position = cdrSubscriptFontPosition

              Next s

              How i have to write correctly, that get range of string as cdrSuperscriptFontPosition ?
              • So, i find a answer. the right to be as follows:
                s.Text.FontPropertiesInRange(3, 5).Position = cdrSuperscriptFontPosition
                Thanks ))