bgregs wrote: ↑Tue Jan 08, 2019 2:13 pm
Hi Wim,
Another good exercise! I don't have time to test this out right now, but I will definitely take a stab at it when I get some time! I found the following function in the VBA API that looks like it _could_ be the function that returns the right information to build out the hierarchy. Again, this is untested, but it sounds promising at least.
Please note, the real relevant information appears to be taken once the returned string is passed into the supporting functions. I'll try to take a look at this, but just thought I'd share in case you wanted to get a head start!
Side note, it looks like the function that will be most useful is TM1SubsetElementDisplayLevel, but you may need information from the function in the link provided first (i.e. use the return value). Also, it looks like the indentation is pulled from a subset, which means that ad-hoc views in the subset editor that aren't saved won't have any indentation information pull (since they only exist in volatile memory). This leads me to believe that this will only work for saved subsets, but again, I will need to test.
https://www.ibm.com/support/knowledgece ... splay.html
Thanks !
I will look at the link. I am not against creating (and deleting) a temporary subset if that would be needed. But using the old VB/VBA API is maybe not the best approach. But still better than writing many many loops and logic ourselves in VBA.
FYI, here's the current code to have the output as in column C. Select the cells you want to indent, then run the macro.
The macro supports more functionality than I showed, so whoever wants to: steal the code and use it.
Code: Select all
Sub TM1_Indent_Elements(control As IRibbonControl)
Const iNrOfSpacesPerLevel As Integer = 4
Dim iLevel As Integer
Dim r As Range
Dim sDim As String
Dim Server_Dimension As String
Dim lTypeOfOutput As Long
Dim lMsgboxAddElementType As VbMsgBoxResult
Dim sElementType_TM1 As String
Dim sElementType_Excel As String
Dim sServer As String
On Error Resume Next
Server_Dimension = InputBox("Please enter the dimension name" & vbNewLine & vbNewLine & _
"If you enter the server name : dimension name string, this server name is used", "(Server:)Dimension name", "")
sServer = Split(Server_Dimension, ":")(0)
sDim = Split(Server_Dimension, ":")(1)
If Run("DIMIX", sServer & ":" & "}Dimensions", sDim) = 0 Then
MsgBox "Please choose a valid value for server:dimension name"
GoTo einde
End If
Server_Dimension = sServer & ":" & sDim
Application.ScreenUpdating = False
lTypeOfOutput = Application.InputBox("Do you want to:" & vbNewLine & vbNewLine & _
"(1) indent cells, in the same column" & vbNewLine & _
"(2) use spaces, in the same column" & vbNewLine & _
"(3) distribute elements over columns" & vbNewLine & vbNewLine, "Indenting elements", 1, , , , , 1)
If lTypeOfOutput < 1 Or lTypeOfOutput > 3 Then
GoTo einde
End If
If lTypeOfOutput <> 3 Then
lMsgboxAddElementType = MsgBox("Do you want to add the element type (like Greek Sigma and small n/s (choose: Yes) or not (choose: No) ?", vbYesNoCancel, "Element")
Else
lMsgboxAddElementType = vbNo
End If
For Each r In Selection.Cells
If Run("DIMIX", Server_Dimension, r.text) > 0 Then
iLevel = Run("DNLEV", Server_Dimension) - Run("ELLEV", Server_Dimension, r.text) - 1
Select Case lMsgboxAddElementType
Case vbcancel: GoTo einde
Case vbYes
sElementType_TM1 = Run("DTYPE", Server_Dimension, r.text)
sElementType_Excel = IIf(sElementType_TM1 = "C", "S", IIf(sElementType_TM1 = "N", "#", "ab"))
Select Case lTypeOfOutput
Case 1
r.InsertIndent iLevel
If r.HasFormula Then
r.formula = "=""" & sElementType_Excel & " " & """ & " & Mid(r.formula, 2)
Else
r.value = "'" & sElementType_Excel & " " & r.text
End If
Case 2
If r.HasFormula Then
r.formula = "=""" & Space(1 + iLevel * iNrOfSpacesPerLevel) & sElementType_Excel & " "" & " & Mid(r.formula, 2)
Else
r.value = "'" & Space(1 + iLevel * iNrOfSpacesPerLevel) & sElementType_Excel & " " & r.text
End If
End Select
If Not r.HasFormula Then
'font type change
With r.Characters(start:=InStr(r.text, sElementType_Excel), length:=IIf(sElementType_TM1 = "S", 2, 1)).Font
.name = IIf(sElementType_TM1 = "C", "Symbol", "Courier")
.FontStyle = "Bold"
.ThemeColor = IIf(sElementType_TM1 = "C", xlThemeColorAccent2, xlThemeColorAccent5)
.TintAndShade = -0.249977111117893
.ThemeFont = xlThemeFontNone
End With
End If
Case vbNo
Select Case lTypeOfOutput
Case 1
r.InsertIndent iLevel
Case 2
If r.HasFormula Then
r.formula = "=""" & Space(1 + iLevel * iNrOfSpacesPerLevel) & """ & " & Mid(r.formula, 2)
Else
r.value = "'" & Space(1 + iLevel * iNrOfSpacesPerLevel) & r.text
End If
Case 3
If iLevel > 0 Then
If r.HasFormula Then
r.Offset(, iLevel).formula = r.formula
Else
r.Offset(, iLevel).value = "'" & r.text
End If
r.ClearContents
End If
End Select
End Select
End If
Next
Selection.Columns.AutoFit
On Error GoTo 0
einde:
Application.ScreenUpdating = True
End Sub
