Public Sub SmartIndenterProcedure()

    Dim OneComp As VBComponent

    Dim StartLine As Long, EndLine As Long

    Dim LineIndex As Long, LineNo As Long, LineCount

    Dim StartCol As Long, EndCol As Long

    Dim LineText As String

    Dim ProcName As String, KeyWord As String

    Dim IndentLevel As Integer, IsAfterUnderLine As Boolean

    Dim IndentThisLine As Boolean, BackThisLine As Boolean

    Dim IndentNextLine As Boolean, BackNextLine As Boolean

    For Each OneComp In ActiveWorkbook.VBProject.VBComponents

        LineCount = OneComp.CodeModule.CountOfLines

        For LineNo = 1 To LineCount

            ProcName = OneComp.CodeModule.ProcOfLine(LineNo, vbext_pk_Proc)

            ProcLineCount = OneComp.CodeModule.ProcCountLines(ProcName, vbext_pk_Proc)

            LineNo = LineNo + ProcLineCount - 1

            StartLine = OneComp.CodeModule.ProcStartLine(ProcName, vbext_pk_Proc)

            EndLine = OneComp.CodeModule.ProcCountLines(ProcName, vbext_pk_Proc) + StartLine

            '循环每一行，删除行首缩进

            For LineIndex = StartLine To EndLine

                LineText = OneComp.CodeModule.Lines(LineIndex, 1)

                Do Until Left(LineText, 1) <> " "

                    OneComp.CodeModule.ReplaceLine LineIndex, Mid(LineText, 2)

                    LineText = OneComp.CodeModule.Lines(LineIndex, 1)

                Loop

            Next LineIndex

            IndentLevel = 0

            For LineIndex = StartLine To EndLine

                LineText = OneComp.CodeModule.Lines(LineIndex, 1)

                KeyWord = Left(LineText, IIf(InStr(LineText, " ") = 0, Len(LineText), InStr(LineText, " ") - 1))

                Select Case KeyWord

                Case "Do", "For", "Private", "Select", "Sub", "While", "With", "Function", "Type"

                    IndentNextLine = True

                Case "If"

                    If Right(LineText, 4) = "Then" Then IndentNextLine = True

                Case "Loop", "Next", "End"

                    BackThisLine = True

                Case "Case", "Else", "ElseIf"

                    BackThisLine = True

                    IndentNextLine = True

                Case "Public", "Private"

                    If Split(LineText, " ")(1) = "Sub" Or Split(LineText, " ")(1) = "Function" Then

                        IndentNextLine = True

                    End If

                End Select

                '判断续行问题

                If Right(LineText, 2) = " _" And IsAfterUnderLine = False Then

                    IndentNextLine = True

                    IsAfterUnderLine = True

                ElseIf Right(LineText, 2) <> " _" And IsAfterUnderLine Then

                    BackNextLine = True

                    IsAfterUnderLine = False

                End If

                '处理本行的缩进级别

                If IndentThisLine Then

                    IndentLevel = IndentLevel + 1

                    IndentThisLine = False

                End If

                If BackThisLine Then

                    IndentLevel = IndentLevel - 1

                    BackThisLine = False

                End If

                On Error GoTo ErrHandler

                OneComp.CodeModule.ReplaceLine LineIndex, Space$(IndentLevel * 4) & LineText

                On Error GoTo 0

                If IndentNextLine Then

                    IndentLevel = IndentLevel + 1

                    IndentNextLine = False

                End If

                If BackNextLine Then

                    IndentLevel = IndentLevel - 1

                    BackNextLine = False

                End If

            Next LineIndex

        Next LineNo

    Next OneComp

    Set OneComp = Nothing

    Exit Sub

ErrHandler:

    If IndentLevel < 0 Then IndentLevel = 0

    Resume Next

End Sub