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