Sub Click(Source As Button)
' Если будет ошибка в работе - перейдет на обработчик ошибок
On Error Goto Handler
'Объявление переменных
' _________________________________________
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim UIview As NotesUIView
Dim uidoc As NotesUIDocument
Dim view As NotesView
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim currNoteID As String
Dim parentDoc As NotesDocument
Dim childDoc As NotesDocument
Dim VName As NotesDateTime
Dim n As Integer
Dim i As Integer
Dim kTime As Variant
'Поля
Dim Organ As Long
Dim Data_sovet As Single
Dim Data_protokol As Single
'Продолжать?
' _________________________________________
Dim askme As Variant
askme = ws.Prompt(PROMPT_YESNO, "Вы уверены?", "Сгенерировать документ?")
If askme=0 Then
Exit Sub
End If
'Подробней об CaretNoteID
currNoteID = ws.CurrentView.CaretNoteID
' документ из представления, копия которого будет сделана
Set parentDoc = session.CurrentDatabase.GetDocumentByID(currNoteID)
If parentDoc Is Nothing Then Error 5002, "Ошибка при получении основного документа"
'Окно ручного ввода
n = Inputbox("Введите количество копий документа", "Создание копий документа")
'Окно ручного ввода 2
kTime = Inputbox("Введите конечную дату", "Создание копий документа","00.00.0000")
'Преобразования типа времени
' kTime= Cdat(kTime)
' If kTime < ParentDoc.data_protokol Then
' ' MsgBox "Ошибка ввода конечной даты"
' Exit Sub
' Elseif kTime = ParentDoc.data_protokol Then
' ' MsgBox "Конечная дата совпала с ParentDoc.data_protokol, копии не нужны"
' ' копии не создаем
' n = 0
' Exit Sub
' Else
' ' (высчитываем кол-во копий, которые вместятся в промежуток от parentDoc.data_protokol до kTime)
' ' (высчитать дни, делим их на 182, n присваиваем результат и создаем n копий)
For i=1 To n
Set VName = New NotesDateTime("" & parentDoc.Getitemvalue("Data_protokol")(0))
Call VName.AdjustDay(182)
Set childDoc = parentDoc.CopyToDatabase( session.CurrentDatabase)
Organ = parentDoc.GetItemValue ("Organ")(0)
childDoc.Organ = Organ+1
' дата совета это дата протокола из оригинального документа
Call childDoc.ReplaceItemValue("Data_sovet", parentDoc.GetItemvalue("Data_protokol"))
' дата протокола это +182 дня
Call childDoc.ReplaceItemValue("Data_protokol", Cdat(VName.Dateonly))
Call childDoc.Save(True,False)
Set parentDoc = childDoc
Next
'Обновляем, чтобы сразу появился в виде
Call ws.ViewRefresh
Exit Sub
' End If
handler:
' Простейший обработчик ошибок
Msgbox "Error:" & Error$ & Chr(10) & Chr(13) & " in line:" & Erl,16
If Not view Is Nothing Then View.AutoUpdate = True ' Это чтобы вернуть автообновление при ошибке.
Resume endh
endh:
End Sub
