Thread: code request
View Single Post
  #6  
Old 19-12-2016, 11:57
mtracy mtracy is offline
Member
 
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 31
Default

macro updated

Private Sub GlobalMacroStorage_SelectionChange()
Dim s As Shape, eff As EffectContour, contR As ShapeRange
Set s = ActiveShape
If Documents.count < 1 Then Exit Sub
If ActiveSelectionRange.count = 0 Then Exit Sub
If ActiveSelectionRange.count > 0 Then
If s.Effects.count > 0 Then
For i = 1 To s.Effects.count
If s.Effects(i).Type = cdrContour Then
Set eff = s.Effects(i).Contour
Set contR = ActiveDocument.CreateShapeRangeFromArray(eff.ContourGroup, s)
contR.AddToSelection
End If
Exit For
Next i
End If
End If
End Sub
__________________
Myron Tracy
Accent Signs
Reply With Quote