La fonction Drillthrough n’est pas implémentée en natif dans Excel.
Microsoft met à disposition sur son site, une macro Excel en VBA permettant de le faire.
Drilling Through to the Details
The OLAP cubes that make up data warehouses contain aggregations of large amounts of multidimensional data. There may be times when you want to view the detail records that contribute to an aggregate value displayed in your PivotTable. Microsoft SQL Server 2000 Analysis Services introduced a feature called drillthrough, which allows you to « drill through » an aggregate to reveal the underlying detail records.
The Excel 2002 (2003 non plus !!) object model does not provide native support for performing drillthrough operations. The following example illustrates how to perform drillthrough operations by using the Microsoft ActiveX® Data Objects Multidimensional (ADOMD) type library.
In this example, a menu command titled OLAP Drillthough is added to the PivotTable context menu. When the user selects the menu item while in the data area of an OLAP PivotTable, the appropriate drillthrough query is submitted to Analysis Services and the detail records are written into a new worksheet.
Private Sub Workbook_Open()
Dim ptcon As CommandBar
Dim cmdDrill As CommandBarControl
Set ptcon = Application.CommandBars(« PivotTable context menu »)
For Each btn In ptcon.Controls
‘Exit the procedure if the mnue item already exists.
If btn.Caption = « OLAP Drillthrough » Then GoTo noadd
Next btn
‘Add an item to the PivotTable context menu.
Set cmdDrill = ptcon.Controls.Add(Type:=msoControlButton, temporary:=True)
‘Set the properties of the menu item.
cmdDrill.Caption = « OLAP Drillthrough »
cmdDrill.OnAction = « ThisWorkbook.Drillthrough »
noadd:
End Sub
Sub Drillthrough()
Dim Cat As ADOMD.Catalog
Dim Conn As ADODB.Connection
Dim qry As String
Dim pcell As PivotCell
Dim pt As PivotTable
Dim i As Integer
Dim rs As ADODB.Recordset
Dim iAxisNum As Integer
Dim sDrillQry As String
‘Set a variable to the PicotCell object of the active cell.
Set pcell = ActiveCell.PivotCell
‘If the cell isn’t part of an OLAP PivotTable, then call
‘the errmsg error handler.
If Not (pcell.PivotTable.PivotCache.OLAP) Then GoTo errmsg
‘If the cell isn’t in the data area of the PivotTable, then
‘call the errmsg error handler.
If pcell.PivotCellType xlPivotCellValue Then GoTo errmsg
Set pt = pcell.PivotTable
‘Make sure that the PivotTable’s cache is connected
‘to the data source.
If Not pt.PivotCache.IsConnected Then
pt.PivotCache.MakeConnection
End If
‘Create a new Catalog.
Set Cat = New ADOMD.Catalog
‘Create a new connection.
Set Conn = New ADODB.Connection
‘Set up the ADOMD catalog.
Set Cat.ActiveConnection = pt.PivotCache.ADOConnection
‘Set up the ADO connection.
Set Conn = pt.PivotCache.ADOConnection
sDrillQry = « Drillthrough maxrows 2500 Select «
‘Loop through row items. The outermost items will be added to
‘the MDX statement.
For i = 1 To pcell.RowItems.Count – 1
If pcell.RowItems(i).Parent.CubeField.Name pcell.RowItems(i + 1).Parent.CubeField.Name Then
sDrillQry = sDrillQry & « { » & pcell.RowItems(i) & « } on » & iAxisNum & « , »
iAxisNum = iAxisNum + 1
End If
Next i
‘Add the innermost row item if more than one item has been added
‘to the row axis.
If pcell.RowItems.Count > 0 Then
sDrillQry = sDrillQry & « { » & pcell.RowItems(i) & « } on » & iAxisNum & « , «
iAxisNum = iAxisNum + 1
End If
‘Loop through row items. The outermost items will be added to
‘ the MDX statement.
For i = 1 To pcell.ColumnItems.Count – 1
If pcell.ColumnItems(i).Parent.CubeField.Name pcell.ColumnItems(i + 1).Parent.CubeField.Name Then
sDrillQry = sDrillQry & « { » & pcell.RowItems(i) & « } on » & iAxisNum & « , «
iAxisNum = iAxisNum + 1
End If
Next i
‘Add the innermost column item if more than one item has been added
‘to the column axis.
If pcell.ColumnItems.Count > 0 Then
sDrillQry = sDrillQry & « { » & pcell.ColumnItems(i) & « } on » & iAxisNum & « , »
iAxisNum = iAxisNum + 1
End If
‘Loop through the visible page items.
For i = 1 To pt.PageFields.Count
sDrillQry = sDrillQry & « { » & pt.PageFields(i).CurrentPageName & « } on » & iAxisNum & « , »
iAxisNum = iAxisNum + 1
Next i
‘ Remove the trailing « , « .
sDrillQry = Left$(sDrillQry, Len(sDrillQry) – 2)
‘ Add the cube name to the MDX statement.
sDrillQry = sDrillQry & » From » & « [ » & pt.PivotCache.CommandText & « ] »
‘ Create a new recordset
Set rs = New ADODB.Recordset
On Error GoTo errmsg
With rs
‘ Pass the MDX atatement to the recordset.
.Source = sDrillQry
Set .ActiveConnection = Conn
‘ Open the recordset.
.Open End With
On Error GoTo 0
‘Add a new worksheet.
Set ws = Worksheets.Add
‘Add a QueryTable to the worksheet.
Connect the query table to
‘the recordset that contains the results of the MDX statement.
With ws.QueryTables.Add(Connection:=rs, Destination:=ws.Range(« A1 »))
.Refresh
End With
Exit Sub
errmsg: MsgBox « Cannot Drillthrough on this selection. »
End Sub
Pas de commentaire reçu(s)
Laisser une réponse