see above
Alright, here is some code that will select the effect. Select your shape or shapes and run the SelectEffects.
Sub SelectEffects() Dim sr As ShapeRange, srNewSelection As New ShapeRange Dim s As Shape Dim eff As Effect Set sr = ActiveSelectionRange For Each s In sr.Shapes If s.Effects.Count > 0 Then AddShape srNewSelection, s Else srNewSelection.Add s End If Next s srNewSelection.CreateSelection End Sub Private Sub AddShape(ByVal sr As ShapeRange, ByVal s As Shape) Dim eff As Effect Dim eff2 As Effect If s Is Nothing Then Exit Sub If sr.IndexOf(s) <> 0 Then Exit Sub sr.Add s For Each eff In s.Effects AddEffect sr, eff Next eff End Sub Private Sub AddEffect(ByVal sr As ShapeRange, ByVal eff As Effect) Dim eff2 As Effect Select Case eff.Type Case cdrTextOnPath AddShape sr, eff.TextOnPath.Path Case cdrExtrude AddShape sr, eff.Extrude.BevelGroup AddShape sr, eff.Extrude.ExtrudeGroup Case cdrDropShadow AddShape sr, eff.DropShadow.ShadowGroup Case cdrControlPath For Each eff2 In eff.ControlPath.Effects AddEffect sr, eff2 Next eff2 Case cdrContour AddShape sr, eff.Contour.ContourGroup Case cdrBlend AddShape sr, eff.Blend.BlendGroup AddShape sr, eff.Blend.StartShape AddShape sr, eff.Blend.EndShape AddShape sr, eff.Blend.Path End Select End Sub
Hope that helps,
-Shelby
Somewhere down the road I had found a way to always select the effects along with the shape but lost it after getting a new pc. Any ideas?
hmmm. Works for DropShadow only. Trying to also add contour to do the same.
Private Sub GlobalMacroStorage_SelectionChange()Dim s As Shape, eff As EffectDropShadow, ShR As ShapeRange, contR As ShapeRangeSet s = ActiveShape If s Is Nothing Then Exit Sub Else If s.Effects.Count > 0 Then For i = 1 To s.Effects.Count If s.Effects(i).Type = cdrDropShadow Then Set eff = s.Effects(i).DropShadow Set ShR = ActiveDocument.CreateShapeRangeFromArray(eff.ShadowGroup, s) ShR.AddToSelection End If
'start of contour test 'If s.Effects(i).Type = cdrContour Then 'Set eff = s.Effects(i).Contour 'Set contR = ActiveDocument.CreateShapeRangeFromArray(eff.ContourGroup, s) 'contR.AddToSelection 'End contour test here
Exit For Next i 'End If End If End IfEnd Sub
Got it!
Private Sub GlobalMacroStorage_SelectionChange()Dim s As Shape, eff As EffectDropShadow, ShR As ShapeRange, contR As ShapeRange, effb As EffectContourSet s = ActiveShapeIf s Is Nothing ThenExit SubElseIf s.Effects.Count > 0 ThenFor i = 1 To s.Effects.CountIf s.Effects(i).Type = cdrDropShadow ThenSet eff = s.Effects(i).DropShadowSet ShR = ActiveDocument.CreateShapeRangeFromArray(eff.ShadowGroup, s)ShR.AddToSelectionEnd If For c = 1 To s.Effects.Count If s.Effects(c).Type = cdrContour Then Set effb = s.Effects(c).Contour Set contR = ActiveDocument.CreateShapeRangeFromArray(effb.ContourGroup, s) contR.AddToSelection End IfNext cExit ForNext iEnd IfEnd IfEnd Sub