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

Тема в разделе "Lotus - Программирование", создана пользователем makaset, 25 мар 2007.

  1. makaset

    makaset Well-Known Member

    Регистрация:
    14 мар 2007
    Сообщения:
    126
    Симпатии:
    0
    Здраствуйте. вот ниже скопировано полный код который я сделал с вашей помощью. теперь еще один вопрос
    в форму 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
     
Загрузка...
Похожие Темы - Еспорт ексел
  1. beloff
    Ответов:
    17
    Просмотров:
    2.734
  2. xKlonx
    Ответов:
    5
    Просмотров:
    3.461
  3. MAcK
    Ответов:
    2
    Просмотров:
    6.607

Поделиться этой страницей