|
|
楼主 |
发表于 2013-9-18 00:10
|
显示全部楼层
1: Attribute VB_Name = "Indent"
2: Option Explicit
3:
4: 'µ±Ç°Ä£¿é×Ô¶¯Ëõ½øµÄ´úÂë ------------------------------------------ 这个工具不支持中文
5: 'http://www.mrexcel.com/forum/excel-questions/666280-problem-smart-indenter.html
6: 'ÂÔÓÐÐÞ¸Ä
7: Sub test()
8: Call miApplyIndent
9: End Sub
10:
11: Sub miApplyIndent()
12: Dim aCodePane As VBIDE.CodePane
13: Dim aStartLine As Long, aEndLine As Long
14: Dim aLineNumber As Long, aStartColumn As Long, aEndColumn As Long
15: Dim aLine As String, aIndentLevel As Integer, aLineIsAfterUnderscore As Boolean
16: Dim aIncThisIndent As Boolean, aDecThisIndent As Boolean
17: Dim aIncNextIndent As Boolean, aDecNextIndent As Boolean
18:
19: Set aCodePane = ActiveWorkbook.VBProject.VBE.ActiveCodePane
20:
21: 'aCodePane.GetSelection aStartLine, aStartColumn, aEndLine, aEndColumn
22: aStartLine = 2
23: aEndLine = ThisWorkbook.VBProject.VBE.SelectedVBComponent.CodeModule.CountOfLines
24: For aLineNumber = aStartLine To aEndLine
25: aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
26: Do Until Left(aLine, 1) <> " "
27: aCodePane.CodeModule.ReplaceLine aLineNumber, Mid(aLine, 2)
28: aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
29: Loop 'Loop repeats until all spaces/indents removed
30: Next aLineNumber
31:
32: For aLineNumber = aStartLine To aEndLine
33: aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
34: Select Case Left(aLine, IIf(InStr(aLine, " ") = 0, 999, InStr(aLine, " ") - 1))
35: Case "Do", "For", "Private", "Select", "Sub", "While", "With", "Function"
36: aIncNextIndent = True 'After certain keywords, indent next line
37: Case "If" 'After If, where line ends in Then, indent next line
38: If Right(aLine, 4) = "Then" Then aIncNextIndent = True
39: Case "Loop", "Next", "End" 'At Loop, Next, End, un-indent this line
40: aDecThisIndent = True
41: Case "Case", "Else", "ElseIf"
42: aDecThisIndent = True 'Un-indent Case or Else
43: aIncNextIndent = True 'Indent line after Case or Else
44: End Select
45:
46: If Right(aLine, 2) = " _" And Not aLineIsAfterUnderscore Then
47: aIncNextIndent = True 'Indent line after underscore
48: aLineIsAfterUnderscore = True 'Set a flag to un-indent the line after next
49: ElseIf Right(aLine, 2) <> " _" And aLineIsAfterUnderscore Then
50: aDecNextIndent = True
51: aLineIsAfterUnderscore = False
52: End If
53:
54: If aIncThisIndent Then aIndentLevel = aIndentLevel + 1: aIncThisIndent = False
55: If aDecThisIndent Then aIndentLevel = aIndentLevel - 1: aDecThisIndent = False
56: On Error GoTo lIndentError
57: aCodePane.CodeModule.ReplaceLine aLineNumber, Space$(aIndentLevel * 4) & aLine
58: On Error GoTo 0
59: If aIncNextIndent Then aIndentLevel = aIndentLevel + 1: aIncNextIndent = False
60: If aDecNextIndent Then aIndentLevel = aIndentLevel - 1: aDecNextIndent = False
61: Next aLineNumber
62: Exit Sub
63: lIndentError:
64: If aIndentLevel < 0 Then aIndentLevel = 0 'Will not happen unless extra lines selected
65: Resume Next
66: End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2013-9-17 23:59
发表于 2013-9-19 15:34
