Set opic = ActiveWindow.Selection.ShapeRange(1)
replace the 2 lines below that one in John's code in post #2 with the 7 lines I suggested