Sub Click(Source As Button)
On Error Goto ErrH
Dim ViewString As String
Dim session As NotesSession
Dim db As NotesDatabase
Dim v As NotesView
Dim docX As NotesDocument
Dim row As Double
Dim xl As Variant
Dim xlWbk As Variant
Set session = New notessession
Set db=session.CurrentDatabase
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim varValues As Variant
Set uidoc = ws.currentDocument
Set doc = uidoc.Document
num%=1
ViewString="PorPrez-reg"
Set v=db.GetView(ViewString)
' Создадим объект Excel
Set xl=CreateObject("Excel.Application")
' Создадим книгу Excel
Set xlWbk=xl.Workbooks.Add
'Работаем с Лист1(Sheet1), активным по умолчанию
'Вывод названия выгрузки
xlWbk.ActiveSheet.Cells(2, 1).RowHeight=30
xlWbk.ActiveSheet.Range("A2").HorizontalAlignment = -4108
xlWbk.ActiveSheet.Cells(2, 1)="Входящие документы"
xlWbk.ActiveSheet.Cells(2, 1).Font.Bold=True
xlWbk.ActiveSheet.Range("A2:H2").Merge
numberrow%=1
row=5
xlWbk.ActiveSheet.Cells(5, 1)="№ п/п"
xlWbk.ActiveSheet.Cells(5, 1).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(5, 1).Font.Bold=True
xlWbk.ActiveSheet.Cells(5, 2)="Дата регистрации"
xlWbk.ActiveSheet.Cells(5, 2).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(5, 2).Font.Bold=True
xlWbk.ActiveSheet.Cells(5, 3)="Рег. номер"
xlWbk.ActiveSheet.Cells(5, 3).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(5, 3).Font.Bold=True
xlWbk.ActiveSheet.Cells(5, 4)="Рег. номер Кор-та"
xlWbk.ActiveSheet.Cells(5, 4).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(5, 4).Font.Bold=True
xlWbk.ActiveSheet.Cells(5, 5)="Корреспондент"
xlWbk.ActiveSheet.Cells(5, 5).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(5, 5).Font.Bold=True
xlWbk.ActiveSheet.Cells(5, 6)="Заголовок"
xlWbk.ActiveSheet.Cells(5, 6).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(5, 6).Font.Bold=True
xlWbk.ActiveSheet.Cells(5, 7)="Рассматривает"
xlWbk.ActiveSheet.Cells(5, 7).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(5, 7).Font.Bold=True
'Ширина столбцов и установка флага переноса по словам в ячейке
xlWbk.ActiveSheet.columns(2).ColumnWidth=25
xlWbk.ActiveSheet.Cells(row, 2).WrapText = True
xlWbk.ActiveSheet.columns(3).ColumnWidth=25
xlWbk.ActiveSheet.Cells(row, 3).WrapText = True
xlWbk.ActiveSheet.columns(4).ColumnWidth=25
xlWbk.ActiveSheet.Cells(row, 4).WrapText = True
xlWbk.ActiveSheet.columns(5).ColumnWidth=25
xlWbk.ActiveSheet.Cells(row, 5).WrapText = True
xlWbk.ActiveSheet.columns(6).ColumnWidth=25
xlWbk.ActiveSheet.Cells(row, 6).WrapText = True
xlWbk.ActiveSheet.columns(7).ColumnWidth=25
xlWbk.ActiveSheet.Cells(row, 7).WrapText = True
'выравнивание по верху, типа xlTop
xlWbk.ActiveSheet.Cells(row, 1).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 2).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 3).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 4).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 5).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 6).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 7).VerticalAlignment = -4160
'встаем на первый документ из вьюхи
Set docX=v.GetFirstDocument
'переходим на строчку ниже для вывода данных
row=row+1
pprez$="0"
If doc.pprez(0) = "все" Then
pprez$="1"
End If
If doc.arh(0) = "Учитывать в архиве" Then
arh$="1"
Else
arh$="0"
End If
'Пробегаем все документы из вью
While Not docX Is Nothing
' Print docX.datereg(0) " " docx.fullregnom(0)
If (docX.archive(0)<>"1" And doc.arh(0) = "") Or doc.arh(0) = "Учитывать в архиве" Then
Print docx.fullregnom(0)
If docX.datereg(0) <>"" Then
If Year (docX.datereg(0)) = Year(doc.srok(0)) Then
If docX.doctype(0) = "01-12.1" Or docX.doctype(0) = "01.1-12.1" Then
If Instr (Lcase(docX.kor(0)), doc.pprez(0)) >0 Or pprez$="1" Then
Print num% ". " Year(docx.datereg(0)) " " docx.fullregnom(0) " " docX.kor(0)
num%=num%+1
'Бордюр вокруг ячеек
xlWbk.ActiveSheet.Cells(row,1).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(row,2).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(row,3).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(row,4).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(row,5).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(row,6).Borders.LineStyle = 1
xlWbk.ActiveSheet.Cells(row,7).Borders.LineStyle = 1
'Вывод информации в Excel
'Формат ячейки - текстовый, чтобы номера можно было отображать вида 0001
xlWbk.ActiveSheet.Cells(row, 1).NumberFormat="@"
'Номер п/п
xlWbk.ActiveSheet.Cells(row, 1)=numberrow%
'Рег. дата
xlWbk.ActiveSheet.Cells(row, 2)=docx.datereg(0)
'Рег. номер
xlWbk.ActiveSheet.Cells(row, 3)=docx.fullregnom(0)
'Рег. номер кор-та
xlWbk.ActiveSheet.Cells(row, 4).NumberFormat="@"
xlWbk.ActiveSheet.Cells(row, 4)=docx.regnom_kor(0)
'Заголовок
xlWbk.ActiveSheet.Cells(row,5)=docx.kor(0)
'Исполнитель
xlWbk.ActiveSheet.Cells(row, 6)=docx.header(0)
'Рассматривает
xlWbk.ActiveSheet.Cells(row, 7)=docx.who(0)
'Увеличили счетчик первого столбца
numberrow%=numberrow%+1
'Применяем форматирование как у заголовков столбцов
xlWbk.ActiveSheet.Cells(row, 1).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 2).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 3).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 4).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 5).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 6).VerticalAlignment = -4160
xlWbk.ActiveSheet.Cells(row, 7).VerticalAlignment = -4160
xlWbk.ActiveSheet.columns(2).ColumnWidth=25
xlWbk.ActiveSheet.Cells(row, 2).WrapText = True
xlWbk.ActiveSheet.columns(3).ColumnWidth=25
xlWbk.ActiveSheet.Cells(row, 3).WrapText = True
xlWbk.ActiveSheet.columns(4).ColumnWidth=105
xlWbk.ActiveSheet.Cells(row, 4).WrapText = True
xlWbk.ActiveSheet.columns(5).ColumnWidth=105
xlWbk.ActiveSheet.Cells(row, 5).WrapText = True
xlWbk.ActiveSheet.columns(6).ColumnWidth=105
xlWbk.ActiveSheet.Cells(row, 6).WrapText = True
xlWbk.ActiveSheet.columns(7).ColumnWidth=105
xlWbk.ActiveSheet.Cells(row, 7).WrapText = True
row=row + 1
End If
End If
End If
End If
End If
'Переходим к новому документу
Set docX=v.GetNextDocument(docX)
'Выводим счетчик, чтобы точно понять когда зависли и скоро ли overflow
Wend
Print "row="row ", numberrow=" numberrow%
'Если нужно выровнять столбец автоматически по ширине, то
' xlWbk.ActiveSheet.Columns(1).AutoFit
' xlWbk.ActiveSheet.Columns(2).AutoFit
' xlWbk.ActiveSheet.Columns(3).AutoFit
' xlWbk.ActiveSheet.Columns(4).AutoFit
'
'Выводим получившийся Excel файл на экран
xl.Visible=True
Exit Sub
ErrH:
Print "Ошибка " & Error(Err) & " в строке " & Erl
Print num% ". " Year(docx.datereg(0)) " " docx.fullregnom(0) " " docX.kor(0)
Exit Sub
End SubДекларации.
Dim nom List As String
Кнопка
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument, curdoc As notesdocument
Dim EObj As Variant
Dim xlsheet As Variant
Dim xlRang As Variant
Dim xlColumn As String
Dim ma(23) As Integer, ma2(23) As Integer, i As Integer
Set db=session.CurrentDatabase
Set curdoc = ws.CurrentDocument.Document
Set view = db.GetView("allkancdocuments") 'без обращений граждан
Call Zapoln
Set EObj = CreateObject("Excel.Application")
Call EObj.Workbooks.Add
Set xlsheet = EObj.Workbooks(1).Worksheets(1)
EObj.visible = True
i = 0
Forall nomID In nom
xlsheet.Cells(i+2,1)= nomID
i = i +1
End Forall
xlsheet.Cells(1,1)= "2022"
xlsheet.Cells(1,2)= "Всего"
xlsheet.Cells(1,4)= "Ответные"
Set doc=view.GetFirstDocument
While Not doc Is Nothing
If doc.datereg(0)>curdoc.dat1(0) And doc.datereg(0)<curdoc.dat2(0) Then
If doc.Form(0)="incoming" Then
ma(0)=ma(0)+1 'Входящие документы все
If doc.responce(0)="1" Then ma(1)=ma(1)+1 'Ответные входящие документы
End If
If doc.Form(0)="outgoing" Then
ma(2)=ma(2)+1 ' Исходящие документы все
If doc.responce(0)="1" Then ma(3)=ma(3)+1 ' Ответные исходящие документы
End If
If doc.Form(0)="inside" Then
ma(4)=ma(4)+1 'Внутренние документы
End If
i = 0
Forall nomID In nom
If doc.doctype(0)= Listtag (nomID) Then ma(i)=ma(i)+1
i = i +1
End Forall
End If
Set doc = view.GetNextDocument( doc )
Wend
i = 0
Forall nomID In nom
xlsheet.Cells(i+2,2)=ma(i) ' строка - столбец
xlsheet.Cells(i+2,4)=ma2(i)
i = i +1
End Forall
End Sub
Sub Zapoln
nom("0")="Входящие документы"
nom("1")="Ответные входящие документы"
nom("2")="Исходящие документы"
nom("3")="Ответные исходящие документы"
nom("4")="Внутренние документы"
nom("5")="Законы )"
////
nom("30-48")="Постановления (30-48)"
nom("30-46")="Распоряжения (30-46)"
nom("30-45")="Поручения (30-45)"
End Sub
Вот код:
Вариант 1. Старый.
Декларации.
Dim nom(23) As String
Кнопка
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument, curdoc As notesdocument
Dim EObj As Variant
Dim xlsheet As Variant
Dim xlRang As Variant
Dim xlColumn As String
Dim ma(23) As Integer, ma2(23) As Integer, i As Integer
Set db=session.CurrentDatabase
Set curdoc = ws.CurrentDocument.Document
Set view = db.GetView("allkancdocuments") 'без обращений граждан
Call Zapoln
Set EObj = CreateObject("Excel.Application")
Call EObj.Workbooks.Add
Set xlsheet = EObj.Workbooks(1).Worksheets(1)
EObj.visible = True
For xx=0 To Ubound (nom) ' 2 блок отчета в Эксель
xlsheet.Cells(xx+2,1)= nom(xx)
Next
xlsheet.Cells(1,1)= "2022"
xlsheet.Cells(1,2)= "Всего"
xlsheet.Cells(1,4)= "Ответные"
Set doc=view.GetFirstDocument
While Not doc Is Nothing
If doc.datereg(0)>curdoc.dat1(0) And doc.datereg(0)<curdoc.dat2(0) Then
If doc.Form(0)="incoming" Then
ma(0)=ma(0)+1 'Входящие документы все
If doc.responce(0)="1" Then ma(1)=ma(1)+1 'Ответные входящие документы
End If
If doc.Form(0)="outgoing" Then
ma(2)=ma(2)+1 ' Исходящие документы все
If doc.responce(0)="1" Then ma(3)=ma(3)+1 ' Ответные исходящие документы
End If
If doc.Form(0)="inside" Then
ma(4)=ma(4)+1 'Внутренние документы
End If
If doc.doctype(0)="НЕТУ" Then ' Законы"
ma(5)=ma(5)+1
If doc.responce(0)="1" Then ma2(5)=ma2(5)+1
End If
........
If doc.doctype(0)="30-48" Then ' Постановления "
ma(21)=ma(21)+1
If doc.responce(0)="1" Then ma2(21)=ma2(21)+1
End If
If doc.doctype(0)="30-46" Then ' Распоряжения "
ma(22)=ma(22)+1
If doc.responce(0)="1" Then ma2(22)=ma2(22)+1
End If
If doc.doctype(0)="30-45" Then ' Поручения "
ma(23)=ma(23)+1
If doc.responce(0)="1" Then ma2(23)=ma2(23)+1
End If
End If
Set doc = view.GetNextDocument( doc )
Wend
For i=0 To Ubound (nom)
xlsheet.Cells(i+2,2)=ma(i) ' строка - столбец
xlsheet.Cells(i+2,4)=ma2(i)
Next
End Sub
Sub Zapoln
nom(0)="Входящие документы"
nom(1)="Ответные входящие документы"
nom(2)="Исходящие документы"
nom(3)="Ответные исходящие документы"
nom(4)="Внутренние документы"
nom(5)="Законы )"
....
nom(23)="Поручения"
End Sub
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument, curdoc As notesdocument
Dim item As notesitem
Dim EObj As Variant
Dim xlsheet As Variant
Dim xlRang As Variant
Dim xlColumn As String
Dim ma(6,23) As Integer, k As Integer, mc(22) As Integer, i As Integer, j As Integer, mb(6,14) As Integer, mf(14) As Integer
On Error Goto ErrH
Dim tipd(2) As Integer ' вх исх вн
Dim dc As NotesDocumentCollection
Dim ftdoc As NotesDocument
Set db=session.CurrentDatabase
Set curdoc = ws.CurrentDocument.Document
Set item=curdoc.GetFirstItem("towns")
Set view = db.GetView("rep_obr1")
Dim flag As Boolean
flag = 0
i=0
k=0
tipd(0)=0
tipd(1)=0
tipd(2)=0
Forall v In item.Values ' проход по всем городам
Set doc=view.GetFirstDocument
While Not doc Is Nothing
If doc.datereg(0)>curdoc.dat1(0) And doc.datereg(0)<curdoc.dat2(0) Then
If doc.form(0) = "inside" Then tipd(0)=tipd(0)+1 ' Считаем сколько всего Вн
If doc.form(0) = "incoming" Then tipd(1)=tipd(1)+1 ' Вх
If doc.form(0) = "outgoing" Then tipd(2)=tipd(2)+1 ' Исх
Set dc = doc.Responses
If dc.Count >0 Then
For xx=1 To dc.Count
Set ftdoc = dc.GetNthDocument(xx)
If ftdoc.form(0) = "inside" Then tipd(0)=tipd(0)+1
If ftdoc.form(0) = "incoming" Then tipd(1)=tipd(1)+1
If ftdoc.form(0) = "outgoing" Then tipd(2)=tipd(2)+1
Next
End If
If doc.obnomen(0)="предложения," Then
If doc.town(0)=v Then ma(i,1)=ma(i,1)+1 ' v - город в цикле, ma(i - колонка / город ,1 - строка номенклатуры текущего города)
If Not item.contains(doc.town(0)) And k=0 Then mc(0)=mc(0)+1 ' Столбец "Прочие"
End If
If doc.obnomen(0)="вопросы обеспечения" Then
If doc.town(0)=v Then ma(i,2)=ma(i,2)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(1)=mc(1)+1
End If
If doc.obnomen(0)="вопросы о труде," Then
If doc.town(0)=v Then ma(i,3)=ma(i,3)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(2)=mc(2)+1
End If
If doc.obnomen(0)="вопросы заработной плат" Then
If doc.town(0)=v Then ma(i,4)=ma(i,4)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(3)=mc(3)+1
End If
If doc.obnomen(0)="здравоохранения" Then
If doc.town(0)=v Then ma(i,5)=ma(i,5)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(4)=mc(4)+1
End If
If doc.obnomen(0)="жилищно-коммунального и бытового обслуживания" Then
If doc.town(0)=v Then ma(i,6)=ma(i,6)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(5)=mc(5)+1
End If
If doc.obnomen(0)="вопросы землеустройства, сва" Then
If doc.town(0)=v Then ma(i,7)=ma(i,7)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(6)=mc(6)+1
End If
If doc.obnomen(0)="вопросы предпринимательства" Then
If doc.town(0)=v Then ma(i,8)=ma(i,8)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(7)=mc(7)+1
End If
If doc.obnomen(0)="вопросы транспорта и связи" Then
If doc.town(0)=v Then ma(i,9)=ma(i,9)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(8)=mc(8)+1
End If
If doc.obnomen(0)="вопросы муниципального хозяйства" Then
If doc.town(0)=v Then ma(i,10)=ma(i,10)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(9)=mc(9)+1
End If
If doc.obnomen(0)="вопросы народного образования " Then
If doc.town(0)=v Then ma(i,11)=ma(i,11)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(10)=mc(10)+1
End If
If doc.obnomen(0)="вопросы по гражданским делам" Then
If doc.town(0)=v Then ma(i,12)=ma(i,12)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(11)=mc(11)+1
End If
If doc.obnomen(0)="административные " Then
If doc.town(0)=v Then ma(i,13)=ma(i,13)+1
If Not item.contains(doc.town(0)) Then mc(12)=mc(12)+1
End If
If doc.obnomen(0)="вопросы по уголовно" Then
If doc.town(0)=v Then ma(i,14)=ma(i,14)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(13)=mc(13)+1
End If
If doc.obnomen(0)="вопросы судопроизводства" Then
If doc.town(0)=v Then ma(i,15)=ma(i,15)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(14)=mc(14)+1
End If
If doc.obnomen(0)="вопросы по безопасности" Then
If doc.town(0)=v Then ma(i,16)=ma(i,16)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(15)=mc(15)+1
End If
If doc.obnomen(0)="вопросы по законодательству" Then
If doc.town(0)=v Then ma(i,17)=ma(i,17)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(16)=mc(16)+1
End If
If doc.obnomen(0)="вопросы принятия гражданства" Then
If doc.town(0)=v Then ma(i,18)=ma(i,18)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(17)=mc(17)+1
End If
If doc.obnomen(0)="разное" Then
If doc.town(0)=v Then ma(i,19)=ma(i,19)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(18)=mc(18)+1
End If
If doc.obnomen(0)="второстепенного характера" Then
If doc.town(0)=v Then ma(i,20)=ma(i,20)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(19)=mc(19)+1
End If
If doc.self(0)="Коллективное" Then
If doc.town(0)=v Then ma(i,21)=ma(i,21)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(20)=mc(20)+1
End If
If doc.first(0)="Повторное" Then
If doc.town(0)=v Then ma(i,22)=ma(i,22)+1
If Not item.contains(doc.town(0)) And k=0 Then mc(21)=mc(21)+1
End If
If doc.soc(0)="пенсионеры" Then
flag = 1
If doc.town(0)=v Then mb(i,0)=mb(i,0)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(0)=mf(0)+1
End If
If doc.soc(0)="иностранные граждане" Then
flag = 1
If doc.town(0)=v Then mb(i,1)=mb(i,1)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(1)=mf(1)+1
End If
If doc.soc(0)="инвалиды по заболеванию" Then
flag = 1
If doc.town(0)=v Then mb(i,2)=mb(i,2)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(2)=mf(2)+1
End If
If doc.soc(0)="инвалиды " Then
flag = 1
If doc.town(0)=v Then mb(i,3)=mb(i,3)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(3)=mf(3)+1
End If
If doc.soc(0)="многодетные" Then
flag = 1
If doc.town(0)=v Then mb(i,4)=mb(i,4)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(4)=mf(4)+1
End If
If doc.soc(0)="рабочие" Then
flag = 1
If doc.town(0)=v Then mb(i,5)=mb(i,5)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(5)=mf(5)+1
End If
If doc.soc(0)="колхозники" Then
flag = 1
If doc.town(0)=v Then mb(i,6)=mb(i,6)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(6)=mf(6)+1
End If
If doc.soc(0)="безработные" Then
flag = 1
If doc.town(0)=v Then mb(i,7)=mb(i,7)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(7)=mf(7)+1
End If
If doc.soc(0)="предприниматели" Then
flag = 1
If doc.town(0)=v Then mb(i,8)=mb(i,8)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(8)=mf(8)+1
End If
If doc.soc(0)="военнослужащие" Then
flag = 1
If doc.town(0)=v Then mb(i,9)=mb(i,9)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(9)=mf(9)+1
End If
If doc.soc(0)="работники бюджетной сферы" Then
flag = 1
If doc.town(0)=v Then mb(i,10)=mb(i,10)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(10)=mf(10)+1
End If
If doc.soc(0)="студенты" Then
flag = 1
If doc.town(0)=v Then mb(i,11)=mb(i,11)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(11)=mf(11)+1
End If
If doc.soc(0)="осужд0ые" Then
flag = 1
If doc.town(0)=v Then mb(i,12)=mb(i,12)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(12)=mf(12)+1
End If
If doc.soc(0)="другие" Then
flag = 1
If doc.town(0)=v Then mb(i,13)=mb(i,13)+1
If Not item.contains(doc.town(0)) And k=0 Then mf(13)=mf(13)+1
End If
If flag = 0 Then
Print doc.header(0)
End If
If k=0 Then ' НЕИСП
adr=doc.adresed(0)
LittleString$ = "Щерба"
positionOfChar& = Instr(adr, LittleString$)
If positionOfChar&<>0 Then s1=s1+1
LittleString$ = "Антюфеева"
positionOfChar& = Instr(adr, LittleString$)
If positionOfChar&<>0 Then a1=a1+1
End If
End If
Set doc = view.GetNextDocument( doc )
flag = 0
Wend
i=i+1
k=1 ' флаг что док уже обработан
End Forall
Set EObj = CreateObject("Excel.Application")
Call EObj.Workbooks.Add("d:\reports\obr1")
Set xlsheet = EObj.Workbooks(1).Worksheets(1)
EObj.visible = True
For i=0 To 6 ' 7 городов
For j =0 To 21 ' 21 ном дело
xlsheet.Cells(j+3,i+2)=ma(i,j+1)
Next
Next
For i=0 To 21 ' Столбец "Прочие"
xlsheet.Cells(i+3,9)=mc(i)
Next
For j=0 To 6 ' по соц статусу
For i=0 To 13
xlsheet.Cells(i+27,j+2)=mb(j,i)
Next
Next
For i=0 To 13 ' Столбец "Прочие"
xlsheet.Cells(i+27,9)=mf(i)
Next
xlsheet.Cells(42,1)="Внутренние"
xlsheet.Cells(43,1)="Входящие"
xlsheet.Cells(44,1)="Исходящие"
xlsheet.Cells(42,2)=tipd(0)
xlsheet.Cells(43,2)=tipd(1)
xlsheet.Cells(44,2)=tipd(2)
Print "tipd(0)=" tipd(0)
Print "tipd(1)=" tipd(1)
Print "tipd(2)=" tipd(2)
Exit Sub
ErrH:
Print "Ошибка " & Error(Err) & " в строке " & Erl
Exit Sub
End Sub
Кнопочка:
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument, curdoc As notesdocument
Dim item As notesitem
Dim EObj As Variant
Dim xlsheet As Variant
Dim xlRang As Variant
Dim xlColumn As String
Dim ma(8,22) As Integer, mb(8,14) As Integer
On Error Goto ErrH
Dim tipd(2) As Integer ' вх исх вн
Dim dc As NotesDocumentCollection
Dim ftdoc As NotesDocument
Set EObj = CreateObject("Excel.Application")
Call EObj.Workbooks.Add
Set xlsheet = EObj.Workbooks(1).Worksheets(1)
EObj.visible = True
Set db=session.CurrentDatabase
Set curdoc = ws.CurrentDocument.Document
Set item=curdoc.GetFirstItem("towns")
Set view = db.GetView("rep_obr1")
tipd(0)=0
tipd(1)=0
tipd(2)=0
Call Zapoln
Dim town(6) As String
i=0
Forall v In item.Values ' проход по всем городам
town(i)=v
xlsheet.Cells(1,i+2)=town(i)
ma(i,22)=0
i=i+1
End Forall
xlsheet.Cells(1,9)="Прочие"
xlsheet.Cells(1,10)="Итого"
For xx=0 To Ubound (obnomen) ' 1 блок отчета в Эксель
xlsheet.Cells(xx+3,1)= obnomen(xx)
Next
xlsheet.Cells(23,1)= "Коллективные обращения" ' сместил на 3 вниз
xlsheet.Cells(24,1)= "Повторные обращения"
For xx=0 To Ubound (soc) ' 2 блок отчета в Эксель
xlsheet.Cells(xx+27,1)= soc(xx)
Next
Set doc=view.GetFirstDocument
While Not doc Is Nothing
If doc.datereg(0)>curdoc.dat1(0) And doc.datereg(0)<curdoc.dat2(0) Then
i=10 ' не выбран город
For yy=0 To Ubound (town) ' выбор города i
If doc.town(0)=town(yy) Then i = yy
Next
If i=10 Then i=7 ' Прочее, горде не найден
For xx=0 To Ubound (obnomen) ' первый блок отчета (0-19 дело)
' If doc.obnomen(0)= obnomen(xx) Then ma(i,xx)=ma(i,xx)+1 : ma(i,22)= ma(i,22) + 1 : ma(8,xx)= ma(8,xx) + 1 ' 22 - строка итого по городам, 8 - столбец итого по номенклатурам (строка - столбец )
If doc.obnomen(0)= obnomen(xx) Then ma(i,xx)=ma(i,xx)+1
Next
' If doc.self(0)="Коллективное" Then ma(i,20)=ma(i,20)+1 : ma(8,20)= ma(8,20) + 1 ' : ma(i,22)= ma(i,22) + 1 8 - строка Итого , 20 - строка в массиве
If doc.self(0)="Коллективное" Then ma(i,20)=ma(i,20)+1
' If doc.first(0)="Повторное" Then ma(i,21)=ma(i,21)+1 : ma(8,21)= ma(8,21) + 1 ': ma(i,22)= ma(i,22) + 1
If doc.first(0)="Повторное" Then ma(i,21)=ma(i,21)+1
For xx=0 To Ubound (soc) ' второй блок отчета
If doc.soc(0)= soc(xx) Then mb(i,xx)=mb(i,xx)+1 : mb(i,14) = mb(i,14) + 1 : mb(8,xx) = mb(8,xx) + 1 ' 14 - колонка итого по городам , 8 - столбец итого по номенклатурам
Next
If doc.form(0) = "inside" Then tipd(0)=tipd(0)+1 ' Считаем сколько всего Вн
If doc.form(0) = "incoming" Then tipd(1)=tipd(1)+1 ' Вх
If doc.form(0) = "outgoing" Then tipd(2)=tipd(2)+1 ' Исх
Set dc = doc.Responses
If dc.Count >0 Then
For xx=1 To dc.Count
Set ftdoc = dc.GetNthDocument(xx)
If ftdoc.form(0) = "inside" Then tipd(0)=tipd(0)+1
If ftdoc.form(0) = "incoming" Then tipd(1)=tipd(1)+1
If ftdoc.form(0) = "outgoing" Then tipd(2)=tipd(2)+1
Next
End If
End If
Set doc = view.GetNextDocument( doc )
Wend
For i=0 To Ubound(ma,1)-1
For j=0 To Ubound(ma,2)-1
ma(i, Ubound(ma,2))=ma(i, Ubound(ma,2)) + ma(i, j)
ma(Ubound(ma,1), j)=ma(Ubound(ma,1), j) + ma(i, j)
Next
Next
For i=0 To 8 ' 7 городов - столбец
For j =0 To 22 ' 21 ном дело - строка
xlsheet.Cells(j+3,i+2)=ma(i,j)
Next
Next
For i=0 To 8 ' по соц статусу
For j=0 To 14
xlsheet.Cells(j+27,i+2)=mb(i,j)
Next
Next
' xlsheet.range("B3:J25").value = ma
xlsheet.Cells(2,10)={=СУММ(J3:J22)} ' Итого
' xlsheet.Cells(23,10)={=СУММ(B23:I23)}
' xlsheet.Cells(24,10)={=СУММ(B24:I24)}
xlsheet.Cells(42,1)="Внутренние"
xlsheet.Cells(43,1)="Входящие"
xlsheet.Cells(44,1)="Исходящие"
xlsheet.Cells(42,2)=tipd(0)
xlsheet.Cells(43,2)=tipd(1)
xlsheet.Cells(44,2)=tipd(2)
Print "Конец "
Exit Sub
ErrH:
Print "Ошибка " & Error(Err) & " в строке " & Erl
Exit Sub
End Sub
Sub Zapoln
obnomen(0)="предложения, письма творческого характера, заявления, жалобы, содержащие сведения о серьезных недостатках и злоупотреблениях"
obnomen(1)="вопросы социального обеспечения"
obnomen(2)="вопросы о труде, кадровая политика"
obnomen(3)="вопросы заработной платы, материальной помощи, индексации вкладов, кредитования"
obnomen(4)="вопросы здравоохранения"
obnomen(5)="вопросы жилищно-коммунального и бытового обслуживания"
obnomen(6)="вопросы землеустройства, сельского хозяйства"
obnomen(7)="вопросы предпринимательства"
obnomen(8)="вопросы транспорта и связи"
obnomen(9)="вопросы муниципального хозяйства"
obnomen(10)="вопросы народного образования и культуры"
obnomen(11)="вопросы по гражданским делам"
obnomen(12)="административные правонарушения"
obnomen(13)="вопросы по уголовно-исполнительной системе"
obnomen(14)="вопросы судопроизводства"
obnomen(15)="вопросы по безопасности, обороне и таможенным органам"
obnomen(16)="вопросы по законодательству"
obnomen(17)="вопросы принятия гражданства"
obnomen(18)="разное"
obnomen(19)="второстепенного, оперативного характера"
soc(0)="пенсионеры"
soc(1)="иностранные граждане"
soc(2)="инвалиды по заболеванию"
soc(3)="3333333333"
soc(4)="444444444"
soc(5)="555555555"
soc(6)="6666666666"
soc(7)="77777777"
soc(8)="88888888"
soc(9)="99999"
soc(10)="р1000000"
soc(11)="студенты"
soc(12)="111111"
soc(13)="другие"
End Sub