Problem hat sich verlagert nachdem ich Fehler die ich gemacht habe (Einrichtung) behoben habe kann ich Debuggen und kenne jetzt die Zeile.

Diese ist im ersten Teil nicht vorhanden.

Die markierte Zeile habe ich in zwei Linien gesetzt damit sie sichtbar wird.

Habe den Code in Einzelschritten durchlaufen lassen und der Bereich läuft mehrfach durch ohne Fehler dann stopped er mit dem Laufzeitfehler 91

Vielleicht ist damit mehr anzufangen, wie mit dem ersten Post

Public Sub CreateTestFromSolution()
    ' Test if active document is a TES
Dim pDocInfo As cDocumentInfo
    Set pDocInfo = New cDocumentInfo
    pDocInfo.FromFileName ActiveDocument.name
    If pDocInfo.TypeEnum <> itsCwTypeTestSolution Then
        MsgBox ActiveDocument.name & " ist keine Test-Lösung (TES)", vbCritical + vbOKOnly, "Courseware Prüfer - " & ActiveDocument.name
        Exit Sub
    End If
    ' copy active document
Dim na As String, nna As String, ndoc As Document, oDoc As Document
    Set oDoc = ActiveDocument
    na = ActiveDocument.FullName
    nna = Replace(na, "TES", "TE")
    Set ndoc = Application.Documents.Add(ActiveDocument.FullName)
    ' now save the copy
    ndoc.SaveAs2 FileName:=nna, FileFormat:=wdFormatXMLDocument, _
        LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15
    oDoc.Close SaveChanges:=wdDoNotSaveChanges
    ndoc.Activate
    ' connect with template 'ITS-Test-Questions.dotm'
    AutoTemplateSub
    ' and remove all comments from previous checking
    RemoveAllCheckComments
    ' and remove the watermark
    TestWatermark itsCwTypeTestQuestions
    ' get the building blocks for 'ITS:TE Anfangstext' and 'ITS:TE:PointsScored'
Dim tpl As Template, bblat As BuildingBlock, bblps As BuildingBlock, ins As Boolean
    For Each tpl In Application.Templates
        If tpl.name = "ITS-Test-Questions.dotm" And ins = False Then
            Set bblat = tpl.BuildingBlockEntries("ITS:TE Anfangstext")
            Set bblps = tpl.BuildingBlockEntries("ITS:TE:PointsScored")
            ins = True
        End If
    Next tpl
    'Debug.Print bblat.Type.name & " " & bblps.Type.name & " " & bblps.Category.name

    ' now change the paragraphs
Dim para As Paragraph, st As Style, nlines As Integer, nshapes As Integer
    For Each para In ActiveDocument.Paragraphs
        ' visual feedback, where we are
        para.Range.Select
        Selection.Collapse wdCollapseStart
        '
        Set st = para.Style
        If Not st Is Nothing Then
            nlines = GetLinesCount(para)
            nshapes = GetParaHeight(para)
            Select Case st.NameLocal
                Case "ITS:TE:List:Dot:Answer"
                    para.Style = ActiveDocument.Styles("ITS:TE:List:Dot:DottedLine")
                    ReplaceWithDottedLine para, nlines, nshapes
                Case "ITS:TE:List:Letter:Answer"
                    para.Style = ActiveDocument.Styles("ITS:TE:List:Letter:DottedLine")
                    ReplaceWithDottedLine para, nlines, nshapes
                Case "ITS:TE:MultipleChoice:Answer"
                    para.Style = ActiveDocument.Styles("ITS:TE:MultipleChoice")
                Case "ITS:TE:Para1:Answer"
                    para.Style = ActiveDocument.Styles("ITS:TE:Para1:DottedLine")
                    ReplaceWithDottedLine para, nlines, nshapes
                Case "ITS:TE:Para2:Answer"
                    para.Style = ActiveDocument.Styles("ITS:TE:Para2:DottedLine")
                    ReplaceWithDottedLine para, nlines, nshapes
                Case "ITS:TE:Para3:Answer"
                    para.Style = ActiveDocument.Styles("ITS:TE:Para3:DottedLine")
                    ReplaceWithDottedLine para, nlines, nshapes
                Case "ITS:TE:SolutionSpace"
                    para.Style = ActiveDocument.Styles("ITS:TE:PointsScored")
                    bblps.Insert para.Range
                Case "ITS:TE:Compose"

                    bblat.Insert para.Range

                Case Else
                    ' do nothing
            End Select
        End If
    Next para

    ' save the results
    ActiveDocument.Save
    ' now check the document
    CheckDocumentShowResult
    
End Sub