quote:

---

Sub test345343()
'Set w = Application.Windows(CStr(ThisDocument.name))

'On Error Resume Next
Set w = Application.Windows.ItemEx(Split(CStr(ThisDocument.Name), ".")(0)) 'Application.Windows(CStr(ThisDocument.name))

w.DeselectAll
For Each Sh In ActivePage.Shapes
If Left(Sh.Name, 3) <> "box" Then
w.Select Sh, visSelect
'Debug.Print Sh
'Sh.Delete
End If
'w.Selection.Delete
Next
End Sub

---