Исходный текст
Option Explicit
Call SetObjPosition(ThisObject)
'==============================================================================
' Задать позицию объекта в составе родительского объекта
'==============================================================================
Sub SetObjPosition(Obj)
Dim StrRet, index, Content, ObjInContent
'Если родительский объект отсутствует, закончить работу
If Obj.Parent Is Nothing Then Exit Sub
'Получить состав родителя. Если там только один объект (наш),
'закончить работу - переставлять нечего
Set Content = Obj.Parent.Objects
If Content.Count<2 Then Exit Sub
'Получить ссылку на наш объект из коллекции (иначе свойство Order не будет работать)
Set ObjInContent = Content.Item(Obj)
'Запросить новую позицию объекта в составе контейнера
StrRet = InputBox("Введите новую позицию объекта в составе """ &_
Obj.Parent.Description & """" & Chr(13) &_
"(от 0 до " & Content.Count-1 & ", текущая " & ObjInContent.Order & "):")
'Если введено не-число или диалог отменен, выйти из процедуры
If (StrRet="") Or (Not IsNumeric(StrRet)) Then Exit Sub
'Получить введенный индекс
index = CLng(StrRet)
'Возможно, введенное число выходит за границы допустимого диапазона
If Not Content.Has(index) Then
MsgBox "Задано недопустимое число.", vbExclamation
Exit Sub
End If
'Переставить объект на указанное место
ObjInContent.Order = index
'Перерисовать объект-контейнер
ThisApplication.Shell.Update(Obj.Parent)
End Sub
'==============================================================================