MARK858
MrExcel MVP
- Joined
- Nov 12, 2010
- Messages
- 16,695
- Office Version
- 365
- Platform
- Windows
- Mobile
Actually remembered I did email it to someone so....
Obviously make sure that you set the reference.
Code:
Public gstr_Wbk_Name As String
' Comments : Code Indenter
'
' REQUIRED REFERENCE : Microsoft Visual Basic for Applications Extensibility 5.3
'
' Date Change
' ------------------------------------------------
' 16-May-13 Created
' 16-Jun-16 Fix up handling of "IF *** THEN"
' 16-Feb-19 Modified to work for me, source: "http://www.mrexcel.com/forum/excel-questions/802527-replicate-indentervba-exe-com-add.html"
Sub MyCodeIndenter()
Dim iLoop As Long
Dim arListOfCodeModules() As String
Dim vbComp As VBIDE.VBComponent
gstr_Wbk_Name = ActiveWorkbook.Name
If Len(gstr_Wbk_Name) > 0 Then
ReDim arListOfCodeModules(1 To 500)
For Each vbComp In Application.Workbooks(gstr_Wbk_Name).VBProject.VBComponents
If vbComp.CodeModule.CountOfLines > 3 Then
iLoop = iLoop + 1
arListOfCodeModules(iLoop) = vbComp.Name
End If
Next vbComp
Set vbComp = Nothing
If iLoop > 0 Then
ReDim Preserve arListOfCodeModules(1 To iLoop)
For iLoop = LBound(arListOfCodeModules) To UBound(arListOfCodeModules)
Call IndentModule(NameOfModule:=arListOfCodeModules(iLoop))
Next iLoop
End If
Erase arListOfCodeModules
MsgBox prompt:="Done", Buttons:=vbExclamation, Title:="VBA Code Indented for file " & gstr_Wbk_Name
End If
End Sub
Private Sub IndentModule(ByVal NameOfModule As String)
On Error Resume Next
Const IndentStep As Long = 2
Dim blnInitialCommentInModule As Boolean
Dim blnIndentNextLine As Boolean, blnOutdentNow As Boolean
Dim blnNoIndent As Boolean
Dim iLoop As Long, HowManyIndents As Long
Dim strMyCodeLine As String
Dim vbComp As VBIDE.VBComponent
Dim vbProj As VBIDE.VBProject
Set vbProj = Workbooks(gstr_Wbk_Name).VBProject
Set vbComp = vbProj.VBComponents(NameOfModule)
With vbComp.CodeModule
blnNoIndent = False
blnInitialCommentInModule = True
blnIndentNextLine = False
blnOutdentNow = False
For iLoop = 1 To .CountOfLines
strMyCodeLine = Trim$(.Lines(iLoop, 1))
If Len(strMyCodeLine) > 0 Then
Select Case FirstWord(strMyCodeLine)
Case "Option"
blnNoIndent = True
Case "Declare", "Enum", "Function", "Private", "Public", "Sub", "Type"
blnNoIndent = True
blnInitialCommentInModule = False
Case "If", "IIf"
blnIndentNextLine = True
If InStr(strMyCodeLine, " Then ") > 0 Then
If Not Replace$(strMyCodeLine, " ", vbNullString) Like "*Then'*" Then blnIndentNextLine = False
End If
blnInitialCommentInModule = False
Case "Do", "For", "Select", "With"
blnIndentNextLine = True
blnInitialCommentInModule = False
Case "Case"
'if PREVIOUS line was not a Select or Case statement, outdent now
If Len(.Lines(iLoop - 1, 1)) > 0 Then
If Not FirstWord(Trim$(.Lines(iLoop - 1, 1))) Like "Case" And Not FirstWord(Trim$(.Lines(iLoop - 1, 1))) Like "Select" Then
blnOutdentNow = True
End If
End If
'if NEXT line is not an End or Case statement, indent next line
If Len(.Lines(iLoop + 1, 1)) > 0 Then
If Not FirstWord(Trim$(.Lines(iLoop + 1, 1))) Like "End" And Not FirstWord(Trim$(.Lines(iLoop + 1, 1))) Like "Case" Then
blnIndentNextLine = True
End If
End If
Case "Else", "ElseIf"
blnOutdentNow = True
blnIndentNextLine = True
blnInitialCommentInModule = False
Case "End"
If strMyCodeLine Like "End Function*" Or strMyCodeLine Like "End Sub*" Then
blnNoIndent = True
End If
If strMyCodeLine Like "End If*" Or strMyCodeLine Like "End Select*" Or strMyCodeLine Like "End With*" Then
blnOutdentNow = True
End If
blnInitialCommentInModule = False
Case "Loop", "Next"
blnOutdentNow = True
blnInitialCommentInModule = False
Case Else
If FirstWord(strMyCodeLine) Like "*:" Then
blnNoIndent = True
End If
End Select
End If
If blnNoIndent Then HowManyIndents = 0
If blnOutdentNow Then HowManyIndents = HowManyIndents - 1
.ReplaceLine iLoop, String(HowManyIndents * IndentStep, " ") & strMyCodeLine
If HowManyIndents = 0 Then HowManyIndents = 1
If blnInitialCommentInModule Then HowManyIndents = 0
If blnIndentNextLine Then HowManyIndents = HowManyIndents + 1
blnNoIndent = False
blnIndentNextLine = False
blnOutdentNow = False
Next iLoop
End With
Set vbComp = Nothing
Set vbProj = Nothing
End Sub
Private Function FirstWord(ByVal WholeLine As String) As String
Dim ar As Variant
ar = Split(WholeLine, " ")
FirstWord = ar(LBound(ar))
Erase ar
End Function
)
