The TM1->Print Report function from Perspectives is useful to generate static reports in bulk for a given set of elements.
The following code is mimicking and extending that functionality to achieve bulk reporting for a TM1 report in a more flexible fashion.
For example you could get a report based on the branches of a company to be saved in each respective branch documents folder instead of getting them all dumped in a single folder or you could also get each branch report emailed to its own branch manager.
Here is the Excel VBA code:
Option Explicit Sub BulkReport() 'http://www.vbaexpress.com/kb/getarticle.php?kb_id=359 '+ admin@bihints mods '+ some of Martin Ryan code Dim NewName As String Dim nm As Name Dim ws As Worksheet Dim TM1Element As String Dim i As Integer Dim myDim As String Dim server As String Dim fullDim As String Dim total As Long Dim folder As String Dim destination As String destination = "\\path\to\Your Branch Documents\" server = "tm1server" myDim = "Store" fullDim = server & ":" & myDim If Run("dimix", server & ":}Dimensions", myDim) = 0 Then MsgBox "The dimension does not exist on this server" Exit Sub End If 'loop over all elements of the branch dimension For i = 1 To Run("dimsiz", fullDim) TM1Element = Run("dimnm", fullDim, i) 'see if there are any sales for that branch total = Application.Run("DBRW", Range("$B$1").Value, "All Staff", Range("$B$7").Value, TM1Element, Range("$B$8").Value, "Total Sales") 'process only level 0 elements and sales <> 0 otherwise skip it If ((Application.Run("ellev", fullDim, TM1Element) = 0) And (total <> 0)) Then 'update the dimension Range("$B$9").Value = "=SUBNM(""" & fullDim & """, """", """ & TM1Element & """, ""Name"")" 'refresh worksheet Application.Run ("TM1RECALC") With Application .ScreenUpdating = False ' Copy specific sheets ' *SET THE SHEET NAMES TO COPY BELOW* ' Array("Sheet Name", "Another sheet name", "And Another")) ' Sheet names go inside quotes, seperated by commas On Error GoTo ErrCatcher 'Sheets(Array("Sheet1", "CopyMe2")).Copy Sheets(Array("Sheet1")).Copy On Error GoTo 0 ' Paste sheets as values ' Remove External Links, Hperlinks and hard-code formulas ' Make sure A1 is selected on all sheets For Each ws In ActiveWorkbook.Worksheets ws.Cells.Copy ws.[A1].PasteSpecial Paste:=xlValues ws.Cells.Hyperlinks.Delete Application.CutCopyMode = False Cells(1, 1).Select ws.Activate Next ws Cells(1, 1).Select 'Remove named ranges except print settings For Each nm In ActiveWorkbook.Names If nm.NameLocal <> "Sheet1!Print_Area" And nm.NameLocal <> "Sheet1!Print_Titles" Then nm.Delete End If Next nm 'name report after the branch name NewName = Left(Range("$B$9").Value, 4) 'Save it in the branch folder of the same name folder = Dir(destination & NewName & "*", vbDirectory) ActiveWorkbook.SaveCopyAs destination & folder & "\" & NewName & "_report.xls" 'skip save file confirmation ActiveWorkbook.Saved = True ActiveWorkbook.Close SaveChanges:=False .ScreenUpdating = True End With End If Next i Exit Sub ErrCatcher: MsgBox "Specified sheets do not exist within this workbook" End Sub
Add new comment