20170719xlVBASmartIndent

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