Представлен изменённый текст продедуры 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