ライブラリ

オートインデント

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
                            
                            '単語が2つ以上あった場合
                            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"
                        
                        '単語が2つ以上で
                        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
 

  2020/12/07   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください
12月 2022年1月 2月
      1
2345678
9101112131415
16171819202122
23242526272829
3031

ブログ投稿者一覧

年別アーカイブ一覧