I make a selection (top) and then run my macro and though the macro does fine it leaves the selection in this state (bottom) whereby requiring me to deselect and select again
What is my code missing?
Sub BreakDimensions()Optimization = TrueActiveDocument.BeginCommandGroup "BreakDimension" Dim sr As ShapeRange, s As Shape Set sr = ActiveSelectionRange For Each s In sr If Not s.Type = cdrLinearDimensionShape Then s.RemoveFromSelection End If Next s ActiveSelection.BreakApart sr.AddToSelection sr.Group Optimization = False ActiveDocument.EndCommandGroup End Sub
I am assuming you want to break apart the dimensions so you can group the shapes and dimensions on the layer to easily rescale it for your documents.
That's what I explained in my original post. The macro works perfectly as I have except that it finishing in a different grouped state as expected. It has round selection glyphs instead of the usual squares
In my original post I forgot to add the image that explained.
try modified code
Sub BreakDimensions()Optimization = TrueActiveDocument.BeginCommandGroup "BreakDimension"Dim sr As ShapeRange, s As ShapeSet sr = ActiveSelectionRangeFor Each s In srIf Not s.Type = cdrLinearDimensionShape Thens.RemoveFromSelectionEnd IfNext sActiveSelection.BreakApartsr.AddToSelection
Optimization = FalseActiveDocument.EndCommandGroupEnd Sub
I did not understand anything from your initial post about that behavior...
Can you check if inside the group it is not at least a OLE object instead of a simple shape?
Something similar hapened to me some months ago (in X8) when tried to programatically select and copy some big shape ranges. This was happening not all the time... I solved the problem only avoiding Windows Clipboard. Duplicating the initial document instead of shapes Copy - Paste and also duplicating shapes from the initial page to the other instead of copying them...
DING! DING! DING! You win a prize! Well how about a big thank you Mek? Again.
I must confess I did not understand what you need. Even if a should...
A shorter variant, maybe more elegant, would be the next, I think:
Dim sr As ShapeRange, srBis As ShapeRange
Set sr = ActiveSelectionRange
Set srBis = sr.Shapes.FindShapes(Type:=cdrLinearDimensionShape)
Set srBis = srBis.BreakApartEx