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 WithEnd Sub