Sub Test()
Dim s As Shape, ext As EffectExtrude
If ActiveShape Is Nothing Then
  MsgBox "Nothing selected", vbCritical
  Exit Sub
End If
Select Case ActiveShape.Type
  Case cdrExtrudeGroupShape

 Set s = ActiveShape
  Case cdrBevelGroupShape

 Set s = ActiveShape.Next.Next
  Case Else

 If ActiveShape.Next.Type = cdrExtrudeGroupShape Then


Set s = ActiveShape.Next

 Else


MsgBox "An extruded shape must be selected"


Exit Sub

 End If
End Select
Set ext = s.Effect.Extrude
Set s = ActiveLayer.CreateArtisticText(2.75, 5, "Text")
With s.Text.FontProperties
  .Name = "Arial Black"
  .Size = 150
End With
s.Fill.UniformColor.RGBAssign 0, 0, 255
With s.CreateExtrude(cdrExtrudeSmallBack, cdrVPLockedToShape, 4, 8).Extrude
  .CopyFrom ext
End With 
End Sub