Function TitreNiveau(niveau As Long) As String
Const c_s_formulaPattern As String = "TitreNiveau("
Dim l_o_rngSearch As Excel.Range
Dim l_o_dico As Object
Dim l_o_ws As Excel.Worksheet
Dim l_l_lvl As Long
Dim l_l_lastCol As Long
Dim l_s_rngFormula As String
Application.Volatile
Set l_o_dico = CreateObject("Scripting.Dictionary")
Set l_o_rngSearch = Application.Caller
Set l_o_ws = Application.Caller.Worksheet
With l_o_ws
l_l_lastCol = .UsedRange(1, 1).Column + .UsedRange.Columns.Count - 1
While Not l_o_rngSearch Is Nothing
l_s_rngFormula = l_o_rngSearch.Formula
If l_s_rngFormula Like "=" & c_s_formulaPattern & "*" Then
l_s_rngFormula = Replace(l_s_rngFormula, "=" & c_s_formulaPattern, vbNullString)
ElseIf l_s_rngFormula Like "=IFERROR(" & c_s_formulaPattern & "*" Then
l_s_rngFormula = Replace(l_s_rngFormula, "=IFERROR(" & c_s_formulaPattern, vbNullString)
End If
If Not l_s_rngFormula Like vbNullString Then
l_l_lvl = CLng(Application.Evaluate("=" & Left(l_s_rngFormula, InStr(l_s_rngFormula, ")") - 1)))
If Not l_o_dico.Exists(l_l_lvl - 1) Then l_o_dico(l_l_lvl) = l_o_dico(l_l_lvl) + 1
End If
If l_o_rngSearch.Row > 1 Then
Set l_o_rngSearch = .Range(.Cells(1, 1), .Cells(l_o_rngSearch.Row - 1, l_l_lastCol)).SpecialCells(xlCellTypeFormulas).Find(c_s_formulaPattern, , xlFormulas, xlPart, xlByRows, xlPrevious, False)
Else
Set l_o_rngSearch = Nothing
End If
Wend
End With
For l_l_lvl = 1 To niveau
If l_o_dico.Exists(l_l_lvl) Then
TitreNiveau = TitreNiveau & l_o_dico(l_l_lvl) & "."
Else
TitreNiveau = TitreNiveau & "X" & "."
End If
Next l_l_lvl
TitreNiveau = TitreNiveau & " "
Set l_o_rngSearch = Nothing
Set l_o_ws = Nothing
Set l_o_dico = Nothing
End Function