VBAのコード(プログラム)のインデントを、
自動的に揃えるプログラム
(一部の処理は省略して、メインのみ)
Private Function prAutoIndent(LineAry As Variant, Optional TabInterval As Long = 4) As Variant
'コードを一旦格納
Dim CodeAry As Variant
CodeAry = LineAry
'アポストロフィを別途配列に格納
'コメント、コメントアウトに対応するよう調整
Dim APAry As Variant
ReDim APAry(LBound(CodeAry, 1) To UBound(CodeAry, 1))
Dim i As Long
For i = LBound(CodeAry, 1) To UBound(CodeAry, 1)
'コメントブロック機能でコメントアウトされていると見なせる場合
If fCode_IsCommentBlock(CStr(CodeAry(i))) = True Then
'コメントブロック部分の左側アポストロフィを配列に格納
Dim LTrimStr As String
LTrimStr = LTrim$(CodeAry(i))
Do
If LTrimStr = "" Then Exit Do
If Left$(LTrimStr, 1) <> "'" Then Exit Do
APAry(i) = APAry(i) & Left$(LTrimStr, 1)
LTrimStr = Mid$(LTrimStr, 2)
Loop
'コメントブロック部分の左側アポストロフィを除去したコードを格納
CodeAry(i) = LTrimStr
End If
Next
'インデント初期値を設定
Const Ini_Indent As Long = 1
Dim Cnt_Indent As Long
Cnt_Indent = 0
Dim Flg_Code As Boolean
Flg_Code = True
Dim C_CodeCond As SC_CodeCondition
Set C_CodeCond = New SC_CodeCondition
'各コードで
For i = LBound(CodeAry, 1) To UBound(CodeAry, 1)
Dim LineStr As String
LineStr = CodeAry(i)
Dim CodeCond As E_CodeCondition
CodeCond = C_CodeCond.CodeCondition(CStr(APAry(i)) & CStr(CodeAry(i)))
'タイトル行と判断できる場合
If CodeCond = ccd_Procedure_Start Then
Flg_Code = True
'インデント初期化
Cnt_Indent = Ini_Indent
'改行があった場合
If fCode_HasNewLine(CStr(CodeAry(i))) = True Then
'フラグを立てる
Dim Flg_TitleCL As Boolean
Flg_TitleCL = True
'スペースを取得
Dim TitleCLSpace As String
TitleCLSpace = String$(InStr(1, CodeAry(i), "("), " ")
End If
'終わりの場合
ElseIf CodeCond = ccd_Procedure_End Then
Flg_Code = False
'タイトル改行があった場合
ElseIf Flg_TitleCL = True Then
'スペースを調整
CodeAry(i) = TitleCLSpace & Trim$(CStr(CodeAry(i)))
'タイトル改行が終了した場合、フラグを下げる
If fCode_HasNewLine(CStr(CodeAry(i))) = False Then
Flg_TitleCL = False
End If
'タイトル情報の場合
ElseIf CodeCond = ccd_Procedure_Info Then
'なにもしない
'プロシージャ間の場合
ElseIf CodeCond = ccd_BetweenProcedure Then
'インデントを除去
' LineAry(i) = Trim$(LineAry(i))
'それ以外の場合
Else
Dim Flg_Word As Boolean
Flg_Word = CBool(Trim$(CStr(CodeAry(i))) <> "")
'単語があった場合
If Flg_Word = True Then
'単語配列を取得しておく
Dim WordAry As Variant
WordAry = Split(Trim$(CStr(CodeAry(i))), " ")
'インデント調整
Select Case CStr(APAry(i)) & CStr(WordAry(0))
Case "End"
If Flg_Code = True Then
'単語が２つ以上あった場合
If 2 <= UBound(WordAry, 1) - LBound(WordAry, 1) + 1 Then
If CStr(WordAry(1)) = "Select" Then
Cnt_Indent = Cnt_Indent - 2
Else
Cnt_Indent = Cnt_Indent - 1
End If
End If
Else
Cnt_Indent = Ini_Indent
End If
Case "Else", "ElseIf", "Next", "Loop", "Case"
Cnt_Indent = Cnt_Indent - 1
End Select
End If
'インデントは最低でも0にしておく
If Cnt_Indent < 0 Then
Cnt_Indent = 0
End If
'インデントを付ける
If 1 <= Cnt_Indent Then
If (Flg_Word = False And CStr(APAry(i)) <> "") = False Then
CodeAry(i) = String$(Cnt_Indent * TabInterval, " ") & Trim$(CStr(CodeAry(i)))
Else
CodeAry(i) = Trim$(CStr(CodeAry(i)))
End If
Else
CodeAry(i) = Trim$(CStr(CodeAry(i)))
End If
If Flg_Word = True Then
'インデント調整
Select Case CStr(APAry(i)) & CStr(WordAry(0))
Case "If", "With", "For", "Do", "Case", "Else", "ElseIf", "Enum", "Type"
If CStr(WordAry(0)) = "If" Then
'If…Then の場合
'If…Then… の場合は対象外
If CStr(WordAry(UBound(WordAry, 1))) = "Then" Then
Cnt_Indent = Cnt_Indent + 1
End If
Else
Cnt_Indent = Cnt_Indent + 1
End If
Case "Select"
If CStr(WordAry(1)) = "Case" Then
Cnt_Indent = Cnt_Indent + 2
End If
Case "Public", "Private"
'単語が２つ以上で
If 2 <= (UBound(WordAry, 1) - LBound(WordAry, 1) + 1) Then
Select Case WordAry(1)
Case "Enum", "Type"
Cnt_Indent = Cnt_Indent + 1
End Select
End If
End Select
End If
End If
Next
'アポストロフィを再結合
For i = LBound(CodeAry, 1) To UBound(CodeAry, 1)
CodeAry(i) = APAry(i) & CodeAry(i)
Next
prAutoIndent = CodeAry
Set C_CodeCond = Nothing
End Function