Исходный код

Option Explicit
Call CreateArbitraryVersion(ThisObject)


'==============================================================================
'Создать новую версию объекта из любой предыдущей (не обязательно последней)

Sub CreateArbitraryVersion(Obj)
        Dim SelVersion, newVersion, EditDlg, SelectedItems, index, strDescr, prototype
        
        'Открыть диалог выбора. В качестве источника данных задать список версий объекта
        Set SelVersion = ThisApplication.Dialogs.SelectDlg
        SelVersion.SelectFrom = Obj.Versions
        SelVersion.Caption = "Создание новой версии из произвольной старой"
        SelVersion.Prompt = "Выберите версию:"
        
        'Если пользователь отменил диалог, закончить работу.
        If SelVersion.Show <> TRUE  Then Exit Sub

        'Если пользователь не выбрал ни одного объекта в диалоге, закончить работу.
        Set SelectedItems = SelVersion.Objects
        If SelectedItems.Count =0  Then Exit Sub
        
        'Получить ссылку на первую из выделенных пользователем версий. Сформировать ее
        'описание и получить порядковый номер в коллекции: 0 - активная (последняя) версия
        Set prototype = SelectedItems(0)
        strDescr = "" & prototype.VersionName & ""
        index = Obj.Versions.Index(prototype)
        
        'Создать новую версию из той, которая была выбрана пользователем
        newVersion = prototype.Versions.Create("New version",_
                     "Created from version No." & index & ", " & strDescr)
        
        'Новая версия автоматически становится активной. 
        'Открыть новую версию в диалоге редактирования.
        Set EditDlg = ThisApplication.Dialogs.EditObjectDlg
        EditDlg.Object = Obj.Versions.Active 
        EditDlg.ActiveForm =  Obj.ObjectDef.InputForms(0)
        EditDlg.Show
        
End Sub
'==============================================================================