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