Thread: code request
View Single Post
Old 20-12-2016, 08:23
mtracy mtracy is offline
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 31
Default Macro updated to include drop shadow effects

Private Sub GlobalMacroStorage_SelectionChange()
Dim s As Shape, effC As EffectContour, effDS As EffectDropShadow, effSh As ShapeRange, i As Long
Set s = ActiveShape
If Not s Is Nothing Then
If s.Effects.count > 0 Then
For i = 1 To s.Effects.count
If s.Effects(i).Type = cdrContour Then
Set effC = s.Effects(i).Contour
Set effSh = ActiveDocument.CreateShapeRangeFromArray(effC.ContourGroup, s)
ElseIf s.Effects(i).Type = cdrDropShadow Then
Set effDS = s.Effects(i).DropShadow
Set effSh = ActiveDocument.CreateShapeRangeFromArray(effDS.ShadowGroup, s)
End If
Next i
End If
End If
End Sub
Myron Tracy
Accent Signs
Reply With Quote