Sub trans_text()
Dim oshp As Shape
Dim otxr2 As TextRange2
Dim L As Long
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.HasTextFrame Then
Set otxr2 = oshp.TextFrame2.TextRange
For L = 1 To otxr2.Characters.Count
otxr2.Characters(L).Font.Fill.Transparency = Rnd * 1
Next L
End If
End Sub