Тема: Выгрузка отчета в Эксель с коллекции документов.
Декларации:
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
 
					