Главная DISCLAIMER Ссылки Карта сайта Контакты
Главная arrow Элементы проектов arrow Полезные мелочи arrow Создание документа на основе данных из отчёта
Создание документа на основе данных из отчёта

Представлен изменённый текст продедуры Export2ExcelViaHTML модуля ST7_WorkArea.avb. Если в параметрах базы данных включен экспорт в Ексель, по нажатию на кнопку экспорта появляется меню, предлагающее кроме непосредственно экспорта в Ексель, различные варианты экспорта отчёта в документ.

 Скачать Module test REP Wizard 2 EXCEL.avb
Тип файла:avb
Версия:
Размер:5.37 Kb
Лицензия:Бесплатно
Скачиваний:715

Вот текст этого модуля

'изменённый текст продедуры "Export2ExcelViaHTML" модуля "ST7_WorkArea.avb"
'Если в параметрах базы данных включен экспорт в Ексель, по нажатию на кнопку экспорта появляется меню,
'предлагающее кроме непосредственно экспорта в Ексель, различные варианты экспорта отчёта в документ.
Sub Export2ExcelViaHTML(Kind, KindID, repID, ByRef Lock)
  Dim wr  : Set wr = WorkArea.CreateReport("RepWizard") 
  If Not wr.Load(repID) Then MsgBox "Заданный отчёт загрузить не удалось" : Exit Sub
  If wr.AccID=0 Then If Kind=acAccount Then wr.AccID=KindID  'для размноженных отчётов "по заданному счёту"
  'здесь необходимо предусмотреть установку других свойств сайта для размноженных отчётов.
  If Not wr.Build Then MsgBox "Заданный отчёт построить не удалось" : Exit Sub
  Dim wkb  : Set wkb = wr.MakeSheet
  Dim s: s="Option Explicit" & vbLf & _
           "Const repID=" & repID & vbLf & _
           "Const AccID=" & kindID & vbLf & _
           vbLf & _
           "Sub ShtBook_OnToExcel(Skip)" & vbLf & _
           "  Skip=True 'Не надо в Ексель. Но в случае ошибки экспорта в HTML возврата нет." & vbLf & _
           "  ShowPopUp ""1:Excell:1 |1:В документ |2:Ост.нач.:2|2:Об.дб.:3|2:Об.кр.:4|2:Ост.кон.:5""" & vbLf & _
           "End Sub" & vbLf & _
           vbLf & _
           "Sub ShtBook_OnPopUp(Command)" & vbLf & _
           "  If command=1 Then Call copySheetToExcell Else Call CreateOp(Command-2)" & vbLf & _
           "End Sub" & vbLf & _
           vbLf & _
           "Sub copySheetToExcell" & vbLf & _
           "  Dim Rd : Set RD = CreateLibObject(""Redirect"")" & vbLf & _
           "  Dim FileName : FileName = Rd.AppPath & ""export.htm""" & vbLf & _
           "  If Not Sheet1.SaveAsHTML(FileName) Then MsgBox ""Error On create HTML file"" : Exit Sub" & vbLf & _
           "  FileName = RD.GetFullPath(FileName)" & vbLf & _
           "  Dim Ex : Set Ex = CreateObject(""Excel.Application"")" & vbLf & _
           "  If Not Ex Is Nothing Then Ex.Visible = True : Ex.Workbooks.Open FileName" & vbLf & _
           "End Sub" & vbLf & _
           vbLf & _
           "Sub CreateOp(SDCE)" & vbLf & _
           "  Dim wr  : Set wr = WorkArea.CreateReport(""RepWizard"") " & vbLf & _
           "  If Not wr.Load(repID) Then MsgBox ""Заданный отчёт загрузить не удалось"" : Exit Sub" & vbLf & _
           "  If wr.AccID=0 Then wr.AccID=accID  'для размноженных отчётов ""по заданному счёту""" & vbLf & _
           "  'здесь необходимо предусмотреть установку других свойств сайта для размноженных отчётов." & vbLf & _
           "  If Not wr.Build Then MsgBox ""Заданный отчёт построить не удалось"" : Exit Sub" & vbLf & _
           "  Dim op : Set op=workarea.CreateOperation : op.Inherit=2+4+8+16+64+128" & vbLf & _
           "  Call copyWrToOp(op, wr, SDCE)" & vbLf & _
           "  Dim frmID  : frmID=workarea.Browse(acForm,0,0,64,""Установка формы упростит выбор шаблона"")" & vbLf & _
           "  op.FormID=frmID" & vbLf & _
           "  op.BrowseTemplate 1 + IIF(frmID=0,0,2) + 4" & vbLf & _
           "  If op.ID=0 Then If ask(""Сохранить операцию"") Then op.Save" & vbLf & _
           "  If op.FormID<>0 And op.ID<>0 Then app.CreateForm op.FormID, op.ID Else op.ShowTrans" & vbLf & _
           "End Sub" & vbLf & _
           vbLf & _
           "Sub copyWrToOp(op, wr, SDCE)  'заполнить операцию колонкой SDCE отчёта от мастера." & vbLf & _
           "  Dim row : row=1" & vbLf & _
           "  Dim level  : Set level=wr.Root  " & vbLf & _
           "  Call recuReadLevel(wr, 0, level, op, row, sdce)" & vbLf & _
           "End Sub" & vbLf & _
           vbLf & _
           "'рекурсивное чтение уровня отчёта в первую проводку операции. SDCE= Колонка Start|Db|Cr|End." & vbLf & _
           "Sub recuReadLevel(wr, levelNo, level, op, row, SDCE)" & vbLf & _
           "  Dim md : If levelNo=0 Then md=0 Else md=wr.LevelMode(levelNo)" & vbLf & _
           "  Select Case md" & vbLf & _
           "    Case 1  : op.Trans(1,row).Date=level.Value" & vbLf & _
           "    Case 3  : op.Trans(1,row).AgToID=level.Value" & vbLf & _
           "    Case 4  : op.Trans(1,row).AgFromID=level.Value" & vbLf & _
           "    Case 5  : op.Trans(1,row).EntID=level.Value" & vbLf & _
           "    Case 9  : op.Trans(1,row).MiscID(workarea.Misc(level.Value).MscNo)=level.Value" & vbLf & _
           "    Case 10  : op.Trans(1,row).SeriesID=level.Value" & vbLf & _
           "  End Select" & vbLf & _
           "  If level.Children=0 Then" & vbLf & _
           "    With op.Trans(1,row)" & vbLf & _
           "      Select Case SDCE" & vbLf & _
           "        Case 0  :.Sum=level.StartDb-level.StartCr  : .Qty=level.QtyStart" & vbLf & _
           "        Case 1  :.Sum=level.TurnDb              : .Qty=level.QtyDb" & vbLf & _
           "        Case 2  :.Sum=level.TurnCr              : .Qty=level.QtyCr" & vbLf & _
           "        Case 3  :.Sum=level.EndDb-level.EndCr    : .Qty=level.QtyEnd" & vbLf & _
           "      End Select" & vbLf & _
           "    End With" & vbLf & _
           "    row=row+1" & vbLf & _
           "  End If" & vbLf & _
           "  Dim n : For n=1 To level.Children" & vbLf & _
           "    Call recuReadLevel(wr, levelNo+1, level.Child(n), op, row, SDCE)" & vbLf & _
           "  Next" & vbLf & _
           "End Sub" & vbLf
  wkb.SetScript s
  Lock=True
End Sub
 
'тестовый запуск (Kind, KindID, repID, ByRef Lock)
'Export2ExcelViaHTML acAccount, 298, 302, Empty