Código VBA para Resumir una AppVBA Excel

Instalar Referencias -> Microsoft Visual Basic for Application Extensibility 5.3

Sub Extraditar()
    Dim comp As VBIDE.VBComponent
    archivo = ActiveWorkbook.Name
    n = 0
    For Each comp In ActiveWorkbook.VBProject.VBComponents
        If comp.Name <> "ImprimirTodo" And comp.Name <> "ThisWorkbook" Then
            'Debug.Print comp.Type
            comp.Export "f:\archivo" & n
            Open "f:\archivo" & n For Append As #1
            Print #1, "----[/" & comp.Name & "]"
            Close #1
            Debug.Print comp.Name
            n = n + 1
            If comp.Type = 100 Then
                Debug.Print comp.Name
                Set rango = ActiveWorkbook.Sheets(comp.Name).UsedRange
                Open "f:\archivo" & n For Output As #1
                For Each r In rango
                    If r.Formula <> "" And r.Value <> "" Then
                        Print #1, "Fórmula de " & r.Address & " = " & r.Value
                        Print #1, "Valor de " & r.Address & " = " & r.Value
                    End If
                Next r
                Set formas = ActiveWorkbook.Sheets(comp.Name).Shapes
                For Each s In formas
                    Print #1, "Forma nueva: " & s.Type & " de nombre [" & s.Name & "]"
                    Print #1, Chr(9) & "En (" & s.Left & ", " & s.Top & ") "
                    Print #1, Chr(9) & "Ancho y alto: " & s.Width & ", " & s.Height
                    Print #1, Chr(9) & "Desde Celda: " & s.TopLeftCell.Address & " hasta celda: " & s.BottomRightCell.Address
                    Print #1, Chr(9) & "Texto: [" & s.TextFrame.Characters.Text & "]"
                    Print #1, Chr(9) & "Relleno: " & s.Fill.BackColor
                Next s
                Print #1, "----[/Hoja " & comp.Name & "]"
                Close #1
                n = n + 1
            End If
        End If
    Next comp
    
    
    Open "f:\tp" & ActiveWorkbook.Name & ".md" For Output As #1
    Print #1, "Resumen código Documento [" & ActiveWorkbook.Name & "]"
    For i = 0 To (n - 1)
        Print #1,
        Print #1, "--------"
        Print #1,
        Arc$ = "f:\archivo" & i
        Debug.Print "Archivo: " & Arc$
        Open (Arc$) For Input As #2
        While Not EOF(2)
            Line Input #2, renglon$
            Print #1, renglon$
        Wend
        Close #2
    Next i
    Close #1
    
End Sub