Option Public
'Константы Excel
'---------------------------------------
Const xlRight=-4152
Const xlLeft=-4131
Const xlCenter=-4108
Const xlTop=-4160
Const xlContinuous=1
Const xlThin=2
Const xlAutomatic=-4105
Const xlEdgeBottom=9

Sub Initialize
	Dim ses As New notesSession
	Dim ws As New notesUIWorkspace
	
	Dim vw As notesView
	Dim vw_col As NotesViewColumn
	Dim vw_ent As NotesViewEntry
	Dim vw_ecol As NotesViewNavigator
	
	Dim xls As Variant
	Dim vc As Variant
	
	Set vw = ws.CurrentView.View ' back-end объект текущего представления
	Set vw_ecol = vw.CreateViewNav
	
	Set xls = CreateObject("Excel.Application") ' Создание COM-объекта приложения MS Excel
	If Isnull(xls) Then 'если не получилось, то выходим
		Messagebox "Не удается создать 'книгу'."
		Exit Sub
	End If
	xls.Visible = True 'для тестирования, в рабочем режиме поставить False, чтобы формирование проходило в фоновом режиме для Excel
	Call xls.Workbooks.Add
	ii%=-1
	For i%=0 To Ubound(vw.Columns) ' формирование шапки отчета, соответствующей шапке представления
		If Not (vw.Columns(i%).isHidden Or vw.Columns(i%).isIcon) Then
			ii%=ii%+1
			ColL$=Chr$(Asc("A")+ii%)
			xls.Columns(ColL$+":"+ColL$).Select
			With xls.Selection.Font
				.Name = vw.Columns(i%).FontFace
				.Size = vw.Columns(i%).FontPointSize 
			End With
			If vw.Columns(i%).Alignment =2 Then
				xls.Selection.HorizontalAlignment = xlCenter
			Elseif vw.Columns(i%).Alignment =1 Then
				xls.Selection.HorizontalAlignment = xlRight
			Else
				xls.Selection.HorizontalAlignment = xlLeft
			End If
			If vw.Columns(i%).FontStyle And 1 Then
				k=0.18
				xls.Selection.Font.Bold = True
			Else
				k=0.15
			End If
			If vw.Columns(i%).FontStyle And 2 Then
				xls.Selection.Font.Italic = True
			End If
			If vw.Columns(i%).FontStyle And 4 Then
				xls.Selection.Font.Underline = 2
			End If
			xls.Selection.VerticalAlignment = xlTop
			xls.Selection.NumberFormat = "@"
			
			xls.Selection.ColumnWidth = vw.Columns(i%).Width*vw.Columns(i%).FontPointSize*k
			xls.Range(ColL$+"1").Select
			xls.Selection.Font.Bold = True
			xls.Selection.Font.Size = vw.Columns(i%).FontPointSize+2
			xls.ActiveCell.FormulaR1C1 = vw.Columns(i%).Title
			
		End If
	Next
	xls.Rows("1:1").Select
	With xls.Selection.Borders(xlEdgeBottom) ' Рисование сетки
		.LineStyle = xlContinuous
		.Weight = xlThin
		.ColorIndex = xlAutomatic
	End With
	
	Set vw_ent = vw_ecol.GetFirst ' Формирование отчета
	r&=2
	While Not vw_ent Is Nothing
		If vw_ent.isValid Then
			Print "Обработка строки № "+Cstr(r&)
			jj%=-1
			For j%=0 To Ubound(vw_ent.ColumnValues)
				If Not (vw.Columns(j%).isHidden Or vw.Columns(j%).isIcon) Then
					jj%=jj%+1
					ColL$=Chr$(Asc("A")+jj%)
					xls.Range(ColL$+Cstr(r&)).Select
					
					If vw_ent.isDocument Then 
						If vw.IsHierarchical And vw_ent.Document.IsResponse Then
							If vw.Columns(j%).IsResponse Then
								If Not vw.Columns(j%).IsHideDetail Then
									vc = vw_ent.ColumnValues(j%)
									If Isarray(vc) Then
										Select Case vw.Columns(j%).ListSep
										Case 1: vcSep$=" "
										Case 2: vcSep$=", "
										Case 3: vcSep$="; "
										Case 4: vcSep$=Chr$(10)
										End Select
										vcs$=""
										For c%=0 To Ubound(vc)
											If c%>0 Then vcs$=vcs$+vcSep$
											vcs$=vcs$+Cstr(vc(c%))
										Next
									Else
										vcs$ = Cstr(vw_ent.ColumnValues(j%))
									End If
									lv%=vw_ent.ColumnIndentLevel
									If vcs$<> "" Then xls.ActiveCell.FormulaR1C1 = Space$(lv%*10)+vcs$
								End If
							End If
						Else
							If Not vw.Columns(j%).IsResponse Then
								If Not (vw.IsHierarchical And vw_ent.Document.IsResponse) Then
									If Not vw.Columns(j%).IsCategory Then
										If Not vw.Columns(j%).IsHideDetail Then
											vc = vw_ent.ColumnValues(j%)
											If Isarray(vc) Then
												Select Case vw.Columns(j%).ListSep
												Case 1: vcSep$=" "
												Case 2: vcSep$=", "
												Case 3: vcSep$="; "
												Case 4: vcSep$=Chr$(10)
												End Select
												vcs$=""
												For c%=0 To Ubound(vc)
													If c%>0 Then vcs$=vcs$+vcSep$
													vcs$=vcs$+Cstr(vc(c%))
												Next
											Else
												vcs$ = Cstr(vw_ent.ColumnValues(j%))
											End If
											
											If vcs$<> "" Then xls.ActiveCell.FormulaR1C1 = vcs$
										End If
									End If
								End If
							End If
						End If
					Elseif vw_ent.IsCategory Then
						vcs$ = Cstr(vw_ent.ColumnValues(j%))
						If vcs$<> "" Then xls.ActiveCell.FormulaR1C1 = vcs$
					Else
						vcs$ = Cstr(vw_ent.ColumnValues(j%))
						If vcs$<> "" Then xls.ActiveCell.FormulaR1C1 = vcs$
					End If
				End If 
			Next
			r&=r&+1
		End If
		Set vw_ent = vw_ecol.GetNext(vw_ent)
	Wend
	xls.Range("A1").Select
	xls.Visible = True
End Sub
