Public Sub SmartIndenterProcedure()
Dim StartLine As Long, EndLine As Long
Dim LineIndex As Long
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
Set ThisCodePane = ActiveWorkbook.VBProject.VBE.ActiveCodePane '获取活动代码窗格
ThisCodePane.GetSelection StartLine, StartCol, EndLine, EndCol '获取光标位置或选定范围的 起止行列号
ProcName = ActiveWorkbook.VBProject.VBE.SelectedVBComponent.CodeModule.ProcOfLine(StartLine, vbext_pk_Proc)
StartLine = ActiveWorkbook.VBProject.VBE.SelectedVBComponent.CodeModule.ProcStartLine(ProcName, vbext_pk_Proc)
EndLine = ActiveWorkbook.VBProject.VBE.SelectedVBComponent.CodeModule.ProcCountLines(ProcName, vbext_pk_Proc) + StartLine
'循环每一行，删除行首缩进
For LineIndex = StartLine To EndLine
LineText = ThisCodePane.CodeModule.Lines(LineIndex, 1)
LineText = RegReplace(LineText, "^\s*")
ThisCodePane.CodeModule.ReplaceLine LineIndex, LineText
Next LineIndex
'设置缩进级别
IndentLevel = 0
For LineIndex = StartLine To EndLine
LineText = ThisCodePane.CodeModule.Lines(LineIndex, 1)
KeyWord = Left(LineText, IIf(InStr(LineText, " ") = 0, Len(LineText), InStr(LineText, " ") - 1))
Select Case KeyWord
Case "Do", "For", "Private", "Public", "Select", "Sub", "While", "With", "Function", "Type", "Property"
IndentNextLine = True 'After certain keywords, indent next line
Case "If" 'After If, where line ends in Then, indent next line
If Right(LineText, 4) = "Then" Then IndentNextLine = True
' If InStr(LineText, " Then ") > 0 Or InStr(LineText, " Then'") > 0 Then IndentNextLine = True
Case "Loop", "Next", "End" 'At Loop, Next, End, un-indent this line
BackThisLine = True
Case "Case", "Else", "ElseIf"
BackThisLine = True 'Un-indent Case or Else
IndentNextLine = True 'Indent line after Case or Else
'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 'Indent line after underscore
IsAfterUnderLine = True 'Set a flag to un-indent the line after next
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
ThisCodePane.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
Set ThisCodePane = Nothing
Exit Sub
ErrHandler:
If IndentLevel < 0 Then IndentLevel = 0 'Will not happen unless extra lines selected
Resume Next
End Sub
Private Function RegReplace(ByVal OrgText As String, ByVal Pattern As String, Optional RepStr As String = "") As String
Dim Regex As Object
Dim newText As String
Set Regex = CreateObject("VBScript.RegExp")
With Regex
.Global = True
.Pattern = Pattern
End With
newText = Regex.Replace(OrgText, RepStr)
RegReplace = newText
Set Regex = Nothing
End Function
