Тема: Добавление атрибутов документа
Существует такая проблема: изначально при настройке все необходимые атрибуты для какого-либо вида документа учесть и привязать зачастую невозможно, по прошествии времени список атрибутов для заданного вида расширяется, но у документов, созданных ранее этого момента (добавления новых атрибутов) новые атрибуты документов автоматически в старых документах не добавляются.
Приводимый ниже макрос позволяет добавить новые атрибуты в старые документы (в те, где данная операция выполнима с учётом прав и статусов).
Макрос работает из режима "Архив" (из главного меню "Документооборот" - "Архив"). Атрибуты документа добавляются для вида документа, на котором был установлен курсор.
Для ускорения работы перед запуском макроса желательно установить фильтр по виду документа, для которого необходимо обновить атрибуты.
Sub FormMacro_AddDocParameters(TCSActiveModule)'Добавление атрибутов документа
Dim DocTypeId ' As Integer Идентификатор вида документа
Dim DocTypeName ' As String Наименование вида документа
Dim DocTypeAttr ' As IGModule Атрибуты документа для заданного вида документа
Dim CurDocAttr ' As IGModule Атрибуты текущего документа
Dim S ' As String
Dim T '
If Not TCSActiveModule.IsEmpty Then
DocTypeId = TCSActiveModule.Properties("TYPE_ID").AsInteger
DocTypeName = TCSActiveModule.Properties("TYPE_NOTE").DisplayText
S = "Обновить список атрибутов для документов вида """ & DocTypeName & """?"
If TCSApp.MessageBox(S, "Запрос", vbYesNo Or vbExclamation) = vbYes Then
If TCSApp.DocTypes.Locate("ID", DocTypeId, 0) Then
Set DocTypeAttr = TCSApp.DocTypes.Properties("DOC_PARAMS").AsIDispatch
If Not DocTypeAttr Is Nothing Then
DocTypeAttr.Refresh
If Not DocTypeAttr.IsEmpty Then
Call TCSApp.ShowProgressMessage("Идёт обработка данных ...", "")
TCSActiveModule.First
Do While Not TCSActiveModule.Eof
If TCSActiveModule.Properties("TYPE_ID").AsSafeInteger = DocTypeId Then
Set CurDocAttr = TCSActiveModule.Properties("DOCPARAMS").AsIDispatch
If Not CurDocAttr Is Nothing Then
CurDocAttr.Refresh
DocTypeAttr.First
If CurDocAttr.AppendAction.Enabled Then
Do While Not DocTypeAttr.Eof
If Not CurDocAttr.Locate("ID", DocTypeAttr.Properties("PAR_ID").AsInteger, 0) Then
Call CurDocAttr.CreateNew
CurDocAttr.Properties("ID").Value = DocTypeAttr.Properties("PAR_ID").AsInteger
CurDocAttr.Properties("REQ").Value = DocTypeAttr.Properties("REQUIRED").AsBoolean
On Error Resume Next
Call CurDocAttr.SaveChanges
Call CurDocAttr.CancelChanges
On Error Goto 0
End If
DocTypeAttr.Next
Loop ' Do While Not DocTypeAttr.Eof
Else
' Нет прав для добавления атрибутов
End If ' If DocTypeAttr.AppendAction.Enabled
End If
Set CurDocAttr = Nothing
End If ' If TCSActiveModule.Properties("TYPE_ID").AsSafeInteger = DocTypeId
TCSActiveModule.Next
Loop
Call TCSApp.HideProgressMessage
Else
Call TCSApp.ShowErrorMessage("Нет привязки атрибутов к документу вида """ & DocTypeName & """!")
End If ' If Not DocTypeAttr.IsEmpty
Else
' Ошибка доступа к атрибутам вида документа !
Call TCSApp.ShowErrorMessage("Ошибка доступа к атрибутам документа для вида """ & DocTypeName & """!")
End If ' If Not DocTypeAttr Is Nothing
Else
Call TCSApp.ShowErrorMessage("Ошибка поиска записи в справочнике ""Виды документов"" по идентификатору " & CStr(DocTypeId) & "!")
End If ' If TCSApp.DocTypes.Locate("ID", DocTypeId, 0)
End If ' If TCSApp.MessageBox(S, "Запрос", vbYesNo Or vbExclamation) = vbYes
Else
T = TCSApp.MessageBox("В текущем модуле нет записей!", "Внимание!", vbOkOnly Or vbExclamation)
End If ' If Not TCSActiveModule.IsEmpty
End Sub