Еспорт в ексел

[makaset]

Здраствуйте. вот ниже скопировано полный код который я сделал с вашей помощью. теперь еще один вопрос
в форму serarch1 хочу поставить несколько чекбос чтобы при копировании в ексел пользователь мог выбрать какие поля импортировать в ексел. т.е пользователь сам отмечает через галочку какие поля экспортировать.
зар ранее благодарен.


Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim session As New NotesSession
Dim searchDoc As NotesDocument
Dim dc As NotesDocumentCollection
Dim find As String
Set searchDoc = New NotesDocument(session.CurrentDatabase)
If ws.DialogBox("SearchForm1", True, True, False, False, False, False, "Search", searchDoc , True) Then
find = {(free= "free")}
find = find + {&(@Created >= @TextToTime("} + searchDoc.Date1(0) + {"))}
find = find + {&(@Created <= @TextToTime("} + searchDoc.Date2(0) + {"))}
Set dc = session.CurrentDatabase.Search(find, Nothing, 0)
Call dc.PutAllInFolder("Search", False)
Call ws.ViewRefresh
' ------------------------------- теперь запускаем ексел
End If
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Add
Set xlsheet = xlApp.Workbooks(1).Worksheets(1)
xlApp.StatusBar = "Производится экспорт. Подождите."
xlApp.Selection.MergeCells = True

neisp =0
vip =0
naisp=0

xlsheet.Cells(1, 3).Value = "Табличный отчет " + searchDoc.Date1(0) +{}
xlsheet.Cells(1, 4).Value = "ПО "+searchDoc.Date2(0) + {}
'xlsheet.Cells(1, 5).Value = + searchDoc.Date1(0) + {}
xlsheet.Cells(1, 3).font.bold = True
xlsheet.Cells(1, 4).font.bold = True

xlsheet.Cells(3, 1).Value = "Подразделения "
xlsheet.Cells(3, 1).font.bold = True
xlsheet.Cells(3, 2).Value = "ФИО Сотрудника"
xlsheet.Cells(3, 2).font.bold = True
xlsheet.Cells(3, 3).Value = "Должность"
xlsheet.Cells(3, 3).font.bold = True
xlsheet.Cells(3, 4).Value = "Причина обращения"
xlsheet.Cells(3, 4).font.bold = True
xlsheet.Cells(3, 5).Value = "Время поступления"
xlsheet.Cells(3, 5).font.bold = True
xlsheet.Cells(3, 6).Value = "ФИО Исполнителя"
xlsheet.Cells(3, 6).font.bold = True
xlsheet.Cells(3, 7).Value = "Действительная причина"
xlsheet.Cells(3, 7).font.bold = True
xlsheet.Cells(3, 8).Value = "Время исполнения"
xlsheet.Cells(3, 8).font.bold = True
' xlsheet.Cells(3, 9).Value = "Время исполнения"
'xlsheet.Cells(3, 9).font.bold = True

r=5
Dim doc As notesdocument
Set doc = dc.getfirstdocument

While Not(doc Is Nothing)

AA$ = Doc.fieldValue0(0) 'подразделения
Ab$ = Doc.fieldValue2(0) 'ФИО сотрудника
Ac$ =Doc.fieldValue1(0) ' Должность
Ad$ = Doc.Damasec(0) ' Причина обращения
Ae$ = Doc.ComputedFieldExample_1(0) ' Время заполнения заявки
Af$ = Doc.ispol1(0) 'Исполнитель
Ag$ = Doc.Damages(0) ' действительная причина
Am$ = Doc.fieldValue8(0) 'время исполнения

xlsheet.Cells(r, 1).Value = AA$
xlsheet.Cells(r, 1).borders.LineStyle = 1
xlsheet.Cells(r, 1).ColumnWidth = 26
xlApp.Selection.HorizontalAlignment = 4
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlApp.Selection.MergeCells = True


xlsheet.Cells(r, 2).Value = Ab$
xlsheet.Cells(r, 2).borders.LineStyle = 1
xlApp.Selection.HorizontalAlignment = 5
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlsheet.Cells(r, 2).ColumnWidth = 26

xlsheet.Cells(r, 3).Value = Ac$
xlsheet.Cells(r, 3).borders.LineStyle = 1
xlsheet.Cells(r,3).ColumnWidth = 26
xlApp.Selection.HorizontalAlignment = 5
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True

xlsheet.Cells(r, 4).Value = Ad$
xlsheet.Cells(r, 4).borders.LineStyle = 1
xlsheet.Cells(r, 4).ColumnWidth = 26
xlApp.Selection.HorizontalAlignment = 4
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlApp.Selection.MergeCells = True


xlsheet.Cells(r, 5).Value = Ae$
xlsheet.Cells(r, 5).borders.LineStyle = 1
xlApp.Selection.HorizontalAlignment = 5
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlsheet.Cells(r, 5).ColumnWidth = 26

xlsheet.Cells(r, 6).Value = Af$
xlsheet.Cells(r, 6).borders.LineStyle = 1
xlsheet.Cells(r,6).ColumnWidth = 26
xlApp.Selection.HorizontalAlignment = 5
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True

xlsheet.Cells(r, 7).Value = Ag$
xlsheet.Cells(r, 7).borders.LineStyle = 1
xlsheet.Cells(r, 7).ColumnWidth = 26
xlApp.Selection.HorizontalAlignment = 4
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlApp.Selection.MergeCells = True


xlsheet.Cells(r, 8).Value = Am$
xlsheet.Cells(r, 8).borders.LineStyle = 1
xlApp.Selection.HorizontalAlignment = 5
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlsheet.Cells(r, 8).ColumnWidth = 26
If af$ = "" Then
rr= rr+1
Else
rf = rf+1
End If

'xlsheet.Cells(r, 9).Value = Am$
'xlsheet.Cells(r,9 ).borders.LineStyle = 1
'xlsheet.Cells(r,9).ColumnWidth = 26
'xlApp.Selection.HorizontalAlignment = 5
'xlApp.Selection.Font.Size = 12
'xlApp.Selection.Font.Bold = True
r = r + 1

Set doc = dc.getnextdocument(doc)


Wend

xlsheet.Cells(r+1, 7).Value ="неисполнено"
xlsheet.Cells(r+1, 7).borders.LineStyle = 1
'xlApp.Selection.HorizontalAlignment = 5
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlsheet.Cells(r+1, 7).ColumnWidth = 26

xlsheet.Cells(r+1, 8).Value =rr
xlsheet.Cells(r+1, 8).borders.LineStyle = 1
'xlApp.Selection.HorizontalAlignment = 5
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlsheet.Cells(r+1, 8).ColumnWidth = 26

xlsheet.Cells(r+2, 7).Value ="Исполнено"
xlsheet.Cells(r+2, 7).borders.LineStyle = 1
'xlApp.Selection.HorizontalAlignment = 5
xlApp.Selection.Font.Size = 12
xlApp.Selection.Font.Bold = True
xlsheet.Cells(r+2, 7).ColumnWidth = 26
xlApp.StatusBar = "Экспорт завершен."
Set xlApp = Nothing

xlsheet.Cells(r+2, 8).Value =rf
xlsheet.Cells(r+2, 8).borders.LineStyle = 1
xlsheet.Cells(r+2, 8).ColumnWidth = 26
xlApp.StatusBar = "Экспорт завершен."
Set xlApp = Nothing



Dim db As NotesDatabase
Dim collection As NotesDocumentCollection

Set db = session.CurrentDatabase
Set collection = db.FTSearch( "free", 20 )
Call collection.RemoveAllFromFolder( "Search" )
Call collection.UpdateAll


End Sub