В качестве примера я покажу как можно построить сводную таблицу в Excel-отчете средствами самого Excel. И аналогично – как можно построить диаграмму в Excel-отчете.
1. Создадим новую модель данных – excel_test_dm, которая будет в качестве источника данных использовать файл Sales.xml из набора demo-файлов BIPublisher 11g.
На всякий случай выкладываю этот файл.
Удостоверимся, что созданная модель возвращает требуемые данные.
2. Создадим новый отчет – excel_test_rep – на базе существующей модели данных – excel_test_dm.
Загрузим новый шаблон разметки для отчета.
Сам Excel-файл шаблона разметки доступен здесь.
3. Сохраним отчет и перейдем в режим его просмотра.
4. Вот такая симпатичная сводная таблица отобразится при открытии файла результата отчета.
Также на другом листе будет доступна и сводная диаграмма.
Причем и сводная таблица, и диаграмма созданы с помощью VBA-кода в момент открытия Excel-файла результата отчета.
BIPublisher же лишь заполнил один лист файла – Data. По данным которого были построены остальные листы отчета – Pivot Chart, Pivot Table.
Думаю, идея понятна. С помощью BIPublisher осуществляется выгрузка данных на один из листов (возможно, лист скрытый) результирующего файла.
Создается макрос на открытие книги (Workbook_Open), который и осуществляет вызов различных VBA-процедур по пост-обработке данных. И сам макрос Workbook_Open и весь VBA-код следует располагать в рамках модуля Workbook ("ЭтаКнига")
Ну и наконец, сам код, используемый в данном примере:
Option Explicit
Const Success = False
Const Failure = True
Const sPivotTableWorksheet = "Pivot Table" 'Name for the PivotTable Worksheet
Const sPivotChartWorksheet = "Pivot Chart" 'Name for the PivotChart Worksheet
Const sDataRange = "XDO_GROUP_?ROW?" 'Named range containing raw data
Const sDataWithCaptionRange = "XDO_RAW_DATA" 'Named range containing raw data with captions
Const sTitle = "Продажи по регионам" 'PivotTable's title
Const sChartType = xlColumnStacked 'Chart type to create (Optional)
Function NameExists(sName As String) As Boolean
' NameExists: Determine if a name exists in a spreadsheet
' Parameters: sName - Name to be checked
' Example: If Not NameExists("Data") then Setup_Data("Data")
' Date Init Modification
' 01/01/01 CWH Initial Programming
On Error GoTo ErrHandler
NameExists = False 'Assume not found
Dim objName As Object
For Each objName In Names
If objName.Name = sName Then
NameExists = Right(Names(sName).Value, 5) <> "#REF!"
Exit For
End If
Next
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"NameExists - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Function
Function ShapeExists(sName As String) As Boolean
' ShapeExists: See if a Shape Exists
' Parameters: sName - Shape Name to be checked
' Example: If not ShapeExists("EasyButton") then _
' Create_Easy_Button "easy", "Show_Prompt", 10, 8
' Date Init Modification
' 01/01/01 CWH Initial Programming
On Error GoTo ErrHandler
ShapeExists = False 'Assume not found
Dim objName As Object
For Each objName In ActiveSheet.Shapes
If objName.Name = sName Then
ShapeExists = True
Exit For
End If
Next
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"ShapeExists - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Function
Function WorkSheetExists(sName As String) As Boolean
' WorkSheetExists:See if a Worksheet Exists
' Parameters: sName - Worksheet Name to be checked
' Example: If not WorkSheetExists("Data") then Setup_Data("Data")
' Date Init Modification
' 01/01/01 CWH Initial Programming
On Error GoTo ErrHandler
WorkSheetExists = False 'Assume not found
Dim objName As Object
For Each objName In Worksheets
If objName.Name = sName Then
WorkSheetExists = True
Exit For
End If
Next
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"WorkSheetExists - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Function
Function PivotTableExists(sWorksheet As String, sName As String) As Boolean
' PivotTableExists:See if a PivotTable Exists
' Parameters: sName - PivotTable Name to be checked
' Example: If not PivotTableExists("pvtHrs") then Setup_pvtHrs
' Date Init Modification
' 01/01/01 CWH Initial Programming
On Error GoTo ErrHandler
PivotTableExists = False 'Assume not found
Dim objName As Object
For Each objName In Worksheets(sWorksheet).PivotTables
If objName.Name = sName Then
PivotTableExists = True
Exit For
End If
Next
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"PivotTableExists - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Function
Function ChartExists(sName As String) As Boolean
' ChartExists: See if a Chart Exists
' Parameters: sName - Chart Name to be checked
' Example: If not ChartExists("chtHrs") then Setup_chtHrs
' Date Init Modification
' 01/01/01 CWH Initial Programming
On Error GoTo ErrHandler
ChartExists = False 'Assume not found
Dim objName As Object
For Each objName In Charts
If objName.Name = sName Then
ChartExists = True
Exit For
End If
Next
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"ChartExists - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Function
Function Settings(sMode As String) As Boolean
' Settings: Saves, sets, and restores current application settings
' Parameters: sMode - "Save", "Restore", "Clear", "Disable", "Debug"
' Example: bResult = Settings("Disable")
' Date Init Modification
' 01/01/01 CWH Initial Programming Copyright 2009 Craig Hatmaker
On Error GoTo ErrHandler
Settings = Failure 'Assume the worst
Static Setting(999, 4) As Variant 'Limit to 1,000 settings, prevent loops
Static iLevel As Integer
Select Case UCase(Trim(sMode))
Case Is = "SAVE"
Setting(iLevel, 0) = ActiveSheet.Type
Setting(iLevel, 1) = ActiveSheet.Name
Setting(iLevel, 2) = Application.EnableEvents
Setting(iLevel, 3) = Application.ScreenUpdating
Setting(iLevel, 4) = Application.Calculation
iLevel = iLevel + 1
Case Is = "RESTORE"
If iLevel > 0 Then
iLevel = iLevel - 1
If Setting(iLevel, 0) = -4167 Then
Worksheets(Setting(iLevel, 1)).Activate
Else
Charts(Setting(iLevel, 1)).Activate
End If
Application.EnableEvents = Setting(iLevel, 2)
Application.ScreenUpdating = Setting(iLevel, 3)
Application.Calculation = Setting(iLevel, 4)
End If
Case Is = "CLEAR"
iLevel = 0
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Case Is = "DISABLE"
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Case Is = "DEBUG"
Debug.Print iLevel, _
Setting(iLevel, 0), _
Setting(iLevel, 1), _
Setting(iLevel, 2), _
Setting(iLevel, 3), _
Setting(iLevel, 4), _
End Select
Settings = Success 'Normal end - no errors
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"Settings - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Function
Function Setup_Pivot(sWorksheet As String, sDataRange As String, _
sTitle As String, sPageFields() As String, _
sRowFields() As String, sColumnFields() As String, _
sDataFields() As String, sSortFields() As String, _
sMaxFields() As String) As Boolean
' Setup_Pivot: Set up a Pivot Table Worksheet and Pivot Table
' Parameters:
' sWorkSheet - The worksheet name where the Pivot Table will be placed
' and the Pivot Table name.
' sDataRange - The data range (raw data/database extract)
' sTitle - A Title to put above the pivot table
' sRowFields(#) - Column headers in the data range that will appear
' down the left of the pivot table
' sColumnFields(#)- Column headers in the data range that will appear
' across the top of the pivot table
' sDataFields(#,2)
' #,0 = Column headers (field name) in the data range that
' will be in the body of the pivot table
' #,1 = Operation to be performed on the data (sum,count,etc.)
' #,2 = Caption to use for the resulting data field
' sSortFields(#,2)
' #,0 = Row or Column field to sort
' #,1 = Ascending or Descending order
' #,2 = Data field to use to sort by
' MaxFields(#,2)
' #,0 = Row or Column field to restrict
' #,1 = Max Number of entries to display
' #,2 = Data field to restrict by
' Example:
' Setup_Pivot sWorkSheet, sDataRange, sTitle, _
' sPageFields(), sRowFields(), sColumnFields(), sDataFields(), _
' sSortFields(), sMaxFields()
' Date Init Modification
' 01/12/06 CWH Initial Programming Copyright 2009 Craig Hatmaker
On Error GoTo ErrHandler '
Setup_Pivot = Failure 'Assume the Worst
Settings "Save" 'Save current settings
Settings "Disable" 'Disable events, updating, calculations
' Dim Statements
Dim i As Integer
' Check for the Pivot Table Worksheet and create it if it doesn't exist
If Not WorkSheetExists(sWorksheet) Then
Sheets.Add
Sheets(ActiveSheet.Name).Name = sWorksheet
Else
Worksheets(sWorksheet).Activate
Cells.Select
Selection.Clear
End If
If PivotTableExists(sWorksheet, sWorksheet) Then
' Just Refresh the Pivot Table if it already exists
Worksheets(sWorksheet).PivotTables(sWorksheet).RefreshTable
Else
' Create the Pivot Table if it doesnt' exist
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:=sDataRange).CreatePivotTable _
TableDestination:=Range("A4"), _
TableName:=sWorksheet
With ActiveSheet.PivotTables(sWorksheet)
.SmallGrid = False
' Add Pivot Table Page Field
For i = 0 To UBound(sPageFields())
If sPageFields(i) <= "" Then Exit For
With .PivotFields(sPageFields(i))
.Orientation = xlPageField
.Subtotals = Array( _
False, False, False, False, False, False, _
False, False, False, False, False, False)
End With
Next i
' Add Pivot Table Row Fields
For i = 0 To UBound(sRowFields())
If sRowFields(i) <= "" Then Exit For
With .PivotFields(sRowFields(i))
.Orientation = xlRowField
.Subtotals = Array( _
False, False, False, False, False, False, _
False, False, False, False, False, False)
End With
Next i
' Add Pivot Table Column Fields
For i = 0 To UBound(sColumnFields())
If sColumnFields(i) <= "" Then Exit For
With .PivotFields(sColumnFields(i))
.Orientation = xlColumnField
.Subtotals = Array( _
False, False, False, False, False, False, _
False, False, False, False, False, False)
End With
Next i
' Add Pivot Table Data Fields, Function & Format
For i = 0 To UBound(sDataFields(), 1)
If sDataFields(i, 0) <= "" Then Exit For
With .PivotFields(sDataFields(i, 0))
.Orientation = xlDataField
If sDataFields(i, 1) <= "" Then sDataFields(i, 1) = "Count"
Select Case UCase(sDataFields(i, 1))
Case Is = "SUM"
.Function = xlSum
Case Is = "AVERAGE"
.Function = xlAverage
Case Is = "MAX"
.Function = xlMax
Case Is = "MIN"
.Function = xlMin
Case Is = "COUNTNUMS"
.Function = xlCountNums
Case Is = "PRODUCT"
.Function = xlProduct
Case Is = "STDEVP"
.Function = xlStDevP
Case Else
.Function = xlCount
End Select
.NumberFormat = "#,###.00_);[Red](#,###.00)"
If sDataFields(i, 2) <= "" Then sDataFields(i, 2) = _
sDataFields(i, 1) & " of " & sDataFields(i, 0)
.Caption = sDataFields(i, 2)
End With
Next i
' Sort columns and rows
For i = 0 To UBound(sSortFields(), 1)
If sSortFields(i, 0) <= "" Then Exit For
If sSortFields(i, 1) = "Descending" Then
.PivotFields(sSortFields(i, 0)).AutoSort _
xlDescending, sSortFields(i, 2)
Else
.PivotFields(sSortFields(i, 0)).AutoSort _
xlAscending, sSortFields(i, 2)
End If
Next i
' Restrict to top/bottom entries
For i = 0 To UBound(sMaxFields(), 1)
If sMaxFields(i, 0) <= "" Then Exit For
If sMaxFields(i, 1) > 0 Then
.PivotFields(sMaxFields(i, 0)).AutoShow _
xlAutomatic, xlTop, Val(sMaxFields(i, 1)), sMaxFields(i, 2)
Else
.PivotFields(sMaxFields(i, 0)).AutoShow _
xlAutomatic, xlBottom, Val(sMaxFields(i, 1)) * -1, _
sMaxFields(i, 2)
End If
Next i
End With
' Orient datafields in columns
If UBound(sDataFields(), 1) > 0 Then
With ActiveSheet.PivotTables(sWorksheet).DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
End If
' Freeze panes on row and column titles
Range(ActiveSheet.PivotTables(sWorksheet).DataBodyRange.Address). _
Cells(1, 1).Select
ActiveWindow.FreezePanes = True
End If
' Add Worksheet Title
With Worksheets(sWorksheet)
.Rows("1:1").MergeCells = False
Range(.Cells(1, 1), .Cells(1, .PivotTables(sWorksheet).TableRange1. _
Columns.Count)).Merge
.Cells(1, 1) = sTitle
.Cells(1, 1).Font.Bold = True
.Cells(1, 1).HorizontalAlignment = xlHAlignLeft
End With
Setup_Pivot = Success 'Successful finish
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"Setup_Pivot - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
Settings "Restore" 'Restore active window & settings
On Error GoTo 0
End Function
Function Setup_PivotChart(sChartSheet As String, sWorksheet As String, _
lChartType As XlChartType, sTitle As String) As Boolean
' Setup_PivotChart:Set up a Pivot Table Chart
' Parameters:
' sChartSheet - The chartsheet to be created to contain the chart
' sWorkSheet - The worksheet name where the Pivot Table data is
' sChartType - The type of chart to created
' Example: Setup_PivotChart "chtHrs", "pvtHrs", "BarClustered"
' Date Init Modification
' 01/12/06 CWH Initial Programming
' 05/15/09 CWH Changed sChartType to lChartType to add flexibility
On Error GoTo ErrHandler '
Setup_PivotChart = Failure 'Assume the Worst
Settings "Save"
Settings "Disable"
' Dim Statements
Dim i As Integer
Dim n As Integer
' Create Chart
Worksheets(sWorksheet).Activate
If Not ChartExists(sChartSheet) Then
Charts.Add
Charts(ActiveChart.Name).Name = sChartSheet
End If
Charts(sChartSheet).Activate
ActiveChart.SetSourceData Source:=Sheets(sWorksheet). _
Range(Sheets(sWorksheet).PivotTables(1).RowRange.Address)
ActiveChart.Location WHERE:=xlLocationAsNewSheet
' Plot Area Formatting
ActiveChart.PlotArea.Fill.OneColorGradient _
Style:=msoGradientDiagonalUp, Variant:=2, Degree:=1
ActiveChart.PlotArea.Fill.ForeColor.SchemeColor = 36
ActiveChart.ChartType = lChartType
' Series Formatting - Choose Variant 1 for Columns and Area, 2 for Bars
For i = 1 To ActiveChart.SeriesCollection.Count
If lChartType = xlPie Or lChartType = xl3DPie _
Or lChartType = xl3DPieExploded Then
On Error Resume Next
For n = 1 To ActiveChart.SeriesCollection(i).Points.Count
ActiveChart.SeriesCollection(i).Points(n).Fill.ForeColor. _
SchemeColor = _
Choose((n Mod 10) + 1, 2, 5, 13, 3, 6, 4, 50, 11, 18, 9)
ActiveChart.ApplyDataLabels
ActiveChart.SeriesCollection(i).DataLabels.Font.Bold = True
ActiveChart.SeriesCollection(i).DataLabels.Font.Color = _
RGB(255, 255, 255)
ActiveChart.SeriesCollection(i).DataLabels.Font.Size = 12
ActiveChart.SeriesCollection(i).DataLabels.NumberFormat = _
"#,###.00_);[Red](#,###.00)"
Next n
On Error GoTo ErrHandler
Else
ActiveChart.SeriesCollection(i).Fill.ForeColor.SchemeColor = _
Choose((i Mod 10) + 1, 2, 5, 13, 3, 6, 4, 50, 11, 18, 9)
End If
Next i
With Charts(sChartSheet)
.HasTitle = True
.ChartTitle.Text = sTitle
End With
Setup_PivotChart = Success 'Successful finish
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"Setup_PivotChart - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
Settings "Restore"
On Error GoTo 0
End Function
Function Do_Pivot() As Boolean
On Error GoTo ErrHandler
Do_Pivot = Failure 'Assume the Worst
With Range(sDataRange)
Names.Add sDataWithCaptionRange, Range(.Cells(1, 1).Offset(-1, 0), .Cells(.Rows.Count, .Columns.Count))
End With
' NOTE TO PGMR: Modify array dimensions (usually not required)
' 0 = the first element so a dimension of 1 means 2 elements
' Changes are required ONLY if you want MORE than 1 element
Dim sPageFields(0) As String '0=# of Page Fields (Optional)
Dim sRowFields(0) As String '0=# of Row Fields (Required)
Dim sColumnFields(1) As String '0=# of Column Fields (Recommended)
Dim sDataFields(0, 2) As String '0=# of Data Field (Required)
Dim sMaxFields(0, 2) As String '0=# of Restrictions (Optional)
Dim sSortFields(0, 2) As String '0=# of Sort fields (Optional)
' NOTE TO PGMR: End modifications to array dimensions
' NOTE TO PGMR: Set parameter values. Set to "" for optional parameters you
' don't want or delete the parameter line from this routine
sPageFields(0) = "Страна" 'Allow filtering entire pivot on this
sRowFields(0) = "Регион" 'This field goes down the side
sColumnFields(0) = "Год" 'This field goes across the top
sColumnFields(1) = "Квартал" 'This field goes across the top
sDataFields(0, 0) = "Продажи" 'This field goes in the body
sDataFields(0, 1) = "SUM" 'Calculation performed
sDataFields(0, 2) = "Сумма продаж" 'Name for the calculated result
sMaxFields(0, 0) = "" 'This field is restricted
sMaxFields(0, 1) = "" 'To the top n values
sMaxFields(0, 2) = "" 'based on this field's value
sSortFields(0, 0) = "Регион" 'This field is sorted
sSortFields(0, 1) = "Ascending" 'in Ascending/Descending order
sSortFields(0, 2) = "Сумма продаж" 'based on this field's value
' NOTE TO PGMR: End modification to parameter values
' Create the Pivot Table
Setup_Pivot sPivotTableWorksheet, sDataWithCaptionRange, sTitle, _
sPageFields(), sRowFields(), sColumnFields(), sDataFields(), _
sSortFields(), sMaxFields()
' Create a chart based on the pivot table (Optional)
Setup_PivotChart sPivotChartWorksheet, sPivotTableWorksheet, sChartType, sTitle
Do_Pivot = Success 'Successful finish
ErrHandler:
If Err.Number <> 0 Then MsgBox _
"Do_Pivot - Error#" & Err.Number & vbCrLf & Err.Description, _
vbCritical, "Error", Err.HelpFile, Err.HelpContext
On Error GoTo 0
End Function
Private Sub Workbook_Open()
Dim bResult As Boolean
bResult = Do_Pivot()
If WorkSheetExists(sPivotTableWorksheet) Then
Worksheets(sPivotTableWorksheet).Activate
End If
End Sub
Большая часть кода взята с ресурса офигенного гуру VBA - Craig Hatmaker
За что я ему очень благодарен!
P.S. Если вы будете использовать данный пример как основу для своих отчетов, то вот краткая инструкция по применению:
1) Создайте свой Excel-шаблон разметки.
2) Убедитесь, что он корректно заполняется данными, будучи используемым в BIPublisher отчете.
3) Важно, чтобы ваши "сырые" данные, отображаемые на листе Data (можете назвать этот лист как угодно, можете вообще скрыть его), предварялись заголовочной строкой.
4) Скопируйте VBA-код выше в Workbook-модуль своего Excel-файла шаблона.
5) Внесите изменения в определение констант в самом начале кода:
Const sPivotTableWorksheet = "Pivot Table" 'Name for the PivotTable Worksheet Const sPivotChartWorksheet = "Pivot Chart" 'Name for the PivotChart Worksheet Const sDataRange = "XDO_GROUP_?ROW?" 'Named range containing raw data Const sDataWithCaptionRange = "XDO_RAW_DATA" 'Named range containing raw data with captions Const sTitle = "Продажи по регионам" 'PivotTable's title Const sChartType = xlColumnStacked 'Chart type to create (Optional)
Самое главное здесь – задать верное название именованного диапазона, который будет содержать ваши "сырые" данные (константа sDataRange).
Типы диаграмм (константа sChartType) можно посмотреть здесь.
6) Внесите изменения в теле функции Do_Pivot()
А именно – поменяйте размерность массивов для различных разделов сводной таблицы, если планируете другое кол-во элементов в них. И задайте значения всем элементам этих массивов.
Комментариев нет:
Отправить комментарий