TM1 Forum

Code: Select all

Option Explicit

Sub Print_Report()

    Dim NewName As String
    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 folder As String
    Dim destination As String
    Dim Subset_Path As String
    Dim Subset As String
    Dim Subset_Less_Extension As String
    
    destination = "C:\Users\SK\Documents\Totem\TM1\Projects\Standard Bank\Cost Centre Reports"
    server = "gti_dev"
    myDim = "Cost Centre"
    fullDim = server & ":" & myDim
   
    Subset_Path = "C:\Users\SK\Documents\TM1\Subsets\" & "Proto*.sub" 'Subset file directory
    Subset = Dir(Subset_Path, vbNormal) 'Variable storing Subset name with .Sub file extension
    
'Check if specified dimension exists
If Run("dimix", server & ":}Dimensions", myDim) = 0 Then
        MsgBox "The dimension does not exist on this server"
        Exit Sub
    End If
    
    'Loop through all the Subsets in the Subset file directory
    While Subset <> ""
    
        'Display the current Subset
        MsgBox Subset
        
        'Remove the .Sub file extension from the Subset name so we can successfully pass it as a valid Subset of the Cost Centre dimension
        Subset_Less_Extension = Left(Subset, Len(Subset) - 4)
        
           'loop over all elements of the current Cost Centre dimension Subset
           For I = 1 To Run("subsiz", fullDim, Subset_Less_Extension)
           
           'Retrieve the name of the current Subset element
         TM1Element = Run("SUBNM", fullDim, Subset_Less_Extension, I, "Name")
      
      'Update the report title
      Range("$O$1").Value = "=SUBNM(""" & fullDim & """, "" & Subset_Less_Extension & "", """ & TM1Element & """, ""Name"")"
        
        'refresh worksheet
        Application.Run ("TM1RECALC")

With Application
                    .ScreenUpdating = False
        
                    
                    '*SET THE SHEET NAMES TO COPIED TO THE NEW WORKBOOK
                    'Sheet names go inside quotes, seperated by commas
                    'eg: Sheets(Array("Budget", "CopyMe2")).Copy
                    Sheets(Array("Budget")).Copy
                     
                     '       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
                     
                     'Name report after the current Cost Centre element name
                    NewName = Right(Range("$O$1").Value, 100)
                     
                     
                     'Save it in the Cost Centre folder of the same name
                      folder = Dir(destination & NewName & "*", vbDirectory)
   
                    ActiveWorkbook.SaveCopyAs destination & folder & "\" & NewName & ".xlsx"
                    'Skip save file confirmation
                    ActiveWorkbook.Saved = True
                    ActiveWorkbook.Close savechanges:=False
                    .ScreenUpdating = True
                End With
                  
               Next I
                   
   'Retrieve the next Subset file in the directory
   Subset = Dir
   
  Exit Sub
  
  Wend
 
End Sub

Code: Select all

folder = Dir(destination & NewName & "*", vbDirectory)

Code: Select all

Subset = Dir