Представлен изменённый текст продедуры Export2ExcelViaHTML модуля ST7_WorkArea.avb. Если в параметрах базы данных включен экспорт в Ексель, по нажатию на кнопку экспорта появляется меню, предлагающее кроме непосредственно экспорта в Ексель, различные варианты экспорта отчёта в документ.
Вот текст этого модуля
'изменённый текст продедуры "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 |