1

Тема: Выгрузка отчета в Эксель с коллекции документов.

Декларации:
Dim obnomen(19) As String
Dim soc(13) 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 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

Поделиться

2

Re: Выгрузка отчета в Эксель с коллекции документов.

Старый вариант кнопки:

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

Поделиться

3

Re: Выгрузка отчета в Эксель с коллекции документов.

Еще один вариант отчета, когда работаем с Лист.
Есть номенклатурное дело и его индекс.
Нужно подсчитать, сколько было кажыдых дел.
А так же - входящих, исходящих и внутренних документов, сколько ответных с них.

Вот код:

Вариант 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

Поделиться

4

Re: Выгрузка отчета в Эксель с коллекции документов.

Вариант 2. Гораздо компактнее по коду.


Декларации.
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

Поделиться

5

Re: Выгрузка отчета в Эксель с коллекции документов.

Еще один вид отчета.

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

Поделиться