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
Categories
Add new comment