0

I need to set the Transparency of Text in a shape via VBA, in fact I need to set the transparency for the whole shape but it's the text I'm stuck with.

I just can't seem to navigate the object model to find the Transparency Property

Function SetTransparency(Value As Single)
On Error GoTo AbortNameShape

If ActiveWindow.Selection.ShapeRange.Count = 0 Then
    MsgBox "No Shapes Selected"
    Exit Function
End If

With ActiveWindow.Selection.ShapeRange
    .Fill.Transparency = Value
    .Line.Transparency = Value
    .TextFrame.TextRange. **HELP**  .Transparency = Value
    End With
AbortNameShape:
MsgBox Err.Description

End Function

Google has given me

.TextFrame.TextRange.Characters.Font.Fill.Transparency

From https://www.mrexcel.com/forum/excel-questions/510589-transparent-text-shapes-textbox-1-a.html

But that fails on the .Fill property of Font object not existing. I'm assuming MS have changed the object model in the 10 years that have passed since the answer was given, but I'm stuck for a current approach.

Thanks

James Travers
  • 3
  • 3

1 Answers1

2

Try this (for just the first member of the current selection)

With ActiveWindow.Selection.ShapeRange(1)
    With .TextFrame2.TextRange.Font.Fill
        .Transparency = 0.5
    End With
End With

If you want to iterate through all the shapes in the current selection, you'll want to test each shape to see if .HasTextFrame and .TextFrame.HasText are true before trying to work with the text.

Steve Rindsberg
  • 14,442
  • 1
  • 29
  • 34
  • Thank you, Do you know why Font.Fill works as a child of TextFrame2 but not of TextFrame? This information wasn't clear from MS at all! – James Travers Sep 20 '17 at 16:57
  • Previous versions of PowerPoint didn't allow us to specify Font.Fill (just Font.Color). When MS added a host of new text/font effects, they provided a TextFrame2 object to give access to the new effects but retained the old TextFrame for compatibility purposes. And you're right: clarity isn't the strong point of MS' documentation. – Steve Rindsberg Sep 21 '17 at 16:00