Добавить в тип объекта определение атрибута Комментарий, если его нет
Option Explicit Call Application_AttributeDefs() '============================================================================== 'Протестировать все свойства и методы объекта TDMSAttributeDefs: 'проверить наличие в коллекции, создание, добавление в коллекцию и удаление. 'Для выполнения скрипта необходимы права системного администратора. '============================================================================== Sub Application_AttributeDefs() Dim ADefs, AttrDef, RetVal, strRetID, dlgInput, SelDlg, ObjDef 'ПОлучить системное имя атрибута для проверки через диалог ввода. Set dlgInput = ThisApplication.Dialogs.SimpleEditDlg dlgInput.Caption = "Системное имя атрибута для проверки" dlgInput.Prompt = "SysID:" RetVal = dlgInput.Show strRetID = dlgInput.Text 'Если пользователь отменил диалог или ввел пустую строку - закончить работу If RetVal <> TRUE Or strRetID = "" Then Exit Sub ' Получаем ссылку на глобальную коллекцию типов атрибутов Set ADefs = ThisApplication.AttributeDefs 'Если нет информации о типах атрибутов, выйти из процедуры If ADefs.Count = 0 Then MsgBox "Типы атрибутов в системе отсутствуют.", _ vbInformation, "Информация о текущей настройке" Exit Sub End If 'Проверить, содержит ли коллекция интересующий нас атрибут If Not ADefs.Has(strRetID) Then ' Если тип атрибута в системе не существует, но пользователь 'просит создать его - создадим. RetVal = MsgBox("Атрибута """ & strRetID & """ в системе" & Chr(13)_ & "не существует. Создать его?", vbQuestion + vbYesNo) If RetVal <> vbNo Then Set AttrDef = ADefs.Create AttrDef.SysName = strRetID AttrDef.Description = "Тестовый атрибут" Else:Exit Sub 'Если типа нет в системе и создавать его не надо - выйти из подпрограммы End If Else 'Если тип уже существует в системе, получить ссылку на него Set AttrDef = ADefs.Item(strRetID) End If 'Сообщить, под каким номером в глобальной коллекции значится наш тип атрибута. RetVal = MsgBox("Тип атрибута """ & strRetID & """ найден в глобальной коллекции" & Chr(13)_ & "под номером " & ADefs.Index(AttrDef) & ". Добавить его в коллекцию типа объекта?"_ , vbQuestion + vbYesNo) 'Добавить тип атрибута к типу объекта If RetVal <> vbNo Then Set ObjDef = ThisApplication.ObjectDefs(0) ObjDef.AttributeDefs.Add AttrDef etVal = MsgBox("Тип атрибута добавлен к типу объекта """ & ObjDef.Description & """." _ & Chr(13) & "Удалить его из коллекции?", vbQuestion + vbYesNo) 'Можно удалить тип из коллекции объекта - он останется в глобальной коллекции ADefs: If RetVal <> vbNo Then ObjDef.AttributeDefs.Remove AttrDef End If RetVal = MsgBox("Удалить тип атрибута """ & strRetID & """ из системы?", vbQuestion + vbYesNo) 'Если пользователь нажал "Да", удалить тип из приложения методом Erase. 'Это может не получиться, если тип существовал ранее и в системе есть объекты с производными атрибутами If RetVal <> vbNo Then On Error Resume Next AttrDef.Erase If Err <> 0 Then MsgBox Err Else MsgBox "Тип атрибута """ & strRetID & """ успешно удален из системы.", vbInformation End If End If End Sub '==============================================================================