TM1 Forum

Code: Select all

Option Explicit

Public db As ADODB.Connection

Global Const sConnection As String = "DATA SOURCE=tm1serv;PROVIDER=TM1OLAP"
Global Const sCube As String = "SalesCube"
Global Const sUser As String = "SalesCubeReader"
Global Const sPass As String = "UsrPwd"


Function OLAP_Connection(OLAP_Connection As Boolean)
    
    OLAP_Connection = False
    Set db = New ADODB.Connection
    
    db.Open sConnection, sUser, sPass
    
    If db Is Nothing Then
        MsgBox "Unable to make a connection to TM1OLAP."
        Exit Function
    Else
        OLAP_Connection = True
    End If
            
    db.Close
    
End Function

Sub cmdReturnTopX_Click()
    Dim iX As Integer
    Dim rs As Cellset
    Dim sQry As String
    Dim sEle As String
    Dim sEles() As String
    Dim icounter As Long
    Dim iCount As Integer, iStartRow As Integer
    
    Dim sCompany As String
    Dim sCustomer As String
    Dim sLocation As String
    Dim sProducts As String
    Dim sMeasure As String
    Dim sYear As String    
    Dim sPeriod As String
    Dim sCount As Integer
       
    IF Not OLAP_Connection Then
        Exit Sub
    End If

    sCompany = ActiveSheet.Range("Company").Value
    sCustomer = ActiveSheet.Range("Customer").Value
    sLocation = ActiveSheet.Range("Location").Value
    sProducts = ActiveSheet.Range("Products").Value
    sMeasure = ActiveSheet.Range("Measure").Value
    sYear = ActiveSheet.Range("Year").Value
    sPeriod = ActiveSheet.Range("Period").Value    
    sCount = ActiveSheet.Range("Number").Value
       
    iCount = sCount
    'Take some parameters off the spreadsheet and use them in the query.
    'The words in CAPS are MDX Functions
    sQry = "SELECT {[Sales_M].[" & sMeasure & " ]} ON COLUMNS, "
    sQry = sQry & "TOPCOUNT([Item].[ " & sProducts & " ].CHILDREN, " & iCount & ", [Sales_M].[ " & sMeasure & " ]) ON ROWS "
    sQry = sQry & "FROM [ " & sCube & " ] "
    sQry = sQry & "WHERE ( [Company].[" & sCompany & "],[Customer].[ " & sCustomer & " ], [Region].[ " & sLocation & " ], "
    sQry = sQry & "[Year].[ " & sYear & " ], [Period].[ " & sPeriod & " ] ) "
    
    'Open a new ADO connection
    Set db = New ADODB.Connection
    
    'Trim sQry
    sQry = Trim(sQry)
    
    'Open a connection to TM1 however you choose to supply credentials (probably not fixed ID as in this example.)
    'MDX does not use the normal connection to TM1 so even if you are connected in Excel
    'You will still need to connect through the TM1OLAP Provider.  You will need to change
    'the way this is done so the security is handled better i.e use a form.

    db.Open sConnection, sUser, sPass
    
    'Open a CellSet to store the results of the query.
    Set rs = New Cellset
    
    'Open the query that was constructed above
    With rs
        .Open sQry, db
    End With
   
    icounter = 0
    ReDim sEles(icounter)
    
    'MDX returns duplicate  elements if unbalanced hierarchies are used.
    'This bit of code just redims the array and provides an array with no duplicates.
    'We need to use the Axes and Positions properties to work through the Cellset results.
    
    For iX = 0 To rs.Axes(1).Positions.Count - 1
        sEle = rs.Axes(1).Positions(iX).Members(0).Caption
        sEles(icounter) = sEle
        icounter = icounter + 1
        ReDim Preserve sEles(icounter)
    Next iX
        
    'Clear the current list of TopX elements.
    ActiveSheet.Range("TopXProducts").ClearContents

    'Fill the row headers with the TopX elements
    iStartRow = 10
    For iX = iStartRow To (iStartRow + icounter) - 1
        Range("A" & iX).Value = sEles(iX - iStartRow)
    Next
      
    Rows(10 & ":109").EntireRow.Hidden = False
    Rows(iX & ":109").EntireRow.Hidden = True
 
    'Recalc the active sheet so the DBRWs correctly reference the filtered topX list
    Application.Run "TM1RECALC1"
        
    db.Close
    Set rs = Nothing

End Sub