' Function for checking the existence of a level
Private Function LevelExist(LevelName As String) As Boolean
    Dim oLv As Level
    LevelExist = False
    For Each oLv In ActiveDesignFile.Levels
        If UCase(oLv.Name) = UCase(LevelName) Then
            LevelExist = True
            Exit Function
        End If
    Next
End Function
 
Sub Texte_on_Level()
    Dim oLv As Level
    Dim neuerLevel As String
    ' Check whether the new name was given as a parameter:
    neuerLevel = KeyinArguments
     
    ' If no parameter is given, use "LevelOfText":
    If Len(Trim(newLevel)) = 0 Then
        newLevel = "LevelOfText"
    End If
     
    ' If the new level name does not exist, then create the level:
    If Not LevelExist(newLevel) Then
        ActiveDesignFile.AddNewLevel newLevel
    End If
    Set oLv = ActiveDesignFile.Levels(newLevel)
     
    ' Look for all text and move it to the new level:
    Dim Ee As ElementEnumerator
    Dim Sc As New ElementScanCriteria
    Sc.ExcludeAllTypes
    Sc.IncludeType msdElementTypeText
    Set Ee = ActiveModelReference.Scan(Sc)
    Do While Ee.MoveNext
        Set Ee.Current.Level = oLv
        Ee.Current.Rewrite
    Loop
End Sub