VBA 自動でコードのインデントを揃えるマクロ

ネットのサンプルなどでは、まれに以下のようなインデントされていないコードがある。

Sub FizzBuzz()
For i = 1 To 100
If i Mod 15 = 0 Then
Debug.Print "FizzBuzz"
ElseIf i Mod 3 = 0 Then
Debug.Print "Fizz"
ElseIf i Mod 5 = 0 Then
Debug.Print "Buzz"
Else
Debug.Print i
End If
Next
End Sub

これはHTMLで単純にタブやスペースを入力しても半角スペースひとつに置き換わってしまうためだと思われる。

個人サイトならHTMLの知識があれば改善できるものの、外部サービスの機能であればどうしようもない。
例えば、はてなブログのコメント欄にインデント有りのコードを張り付けてもインデントは消えてしまうし、掲示板やQAサイトなどでも対策が取られていない場合はインデントがなくなる。

また、Webでなくても、複数人がメンテナンスしたマクロはインデントがガタガタになっていることもある。

今回はこれをコードでなんとかしようという話。

まず断りを入れておくと、今回はかなりやっつけ仕事で、冗長なコードになっている。
ロジックを考える過程で綺麗に書こうとは考えず、勢いでガリガリ書いてなんとか動く形にもっていったというところ。

コード

使い方は、インデントされていないコード（またはガタガタのコード）をクリップボードにコピーしてから、以下のAutoIndenterを実行すると、イミディエイトウインドウに整形されたコードが出てくる。ひとまず上のFizzBuzzで試してみてほしい。
※下にかいてある二つの関数も必要

Sub AutoIndenter()
    Dim CB As New DataObject
    CB.GetFromClipboard
    If Not CB.GetFormat(1) Then
        MsgBox "クリップボードが空です。", vbExclamation
        Exit Sub
    End If
    Dim Lines() As String: Lines = Split(CB.GetText, vbNewLine)
    For Each x In Lines
        x2 = ConvertString(x)
        If InStr(1, x2, "End Sub") > 0 Then
            T = 0
            Debug.Print String(T, vbTab) & Trim(x)
        ElseIf InStr(1, x2, "Exit Sub") > 0 Then
            Debug.Print String(T, vbTab) & Trim(x)
        ElseIf InStr(1, x2, "Go Sub") > 0 Then
            Debug.Print String(T, vbTab) & Trim(x)
        ElseIf InStr(1, x2, "Sub ") > 0 Then
            Debug.Print
            Debug.Print String(T, vbTab) & Trim(x)
            T = 1
        ElseIf InStr(1, x2, "End Function") > 0 Then
            T = 0
            Debug.Print String(T, vbTab) & Trim(x)
        ElseIf InStr(1, x2, "Function ") > 0 Then
            Debug.Print
            Debug.Print String(T, vbTab) & Trim(x)
            T = 1
        ElseIf InStr(1, x2, "For ") > 0 Then
            Debug.Print String(T, vbTab) & Trim(x)
            T = T + 1
        ElseIf InStr(1, x2, "Next") > 0 Then
            T = T - 1
            Debug.Print String(T, vbTab) & Trim(x)
        ElseIf InStr(1, x2, "Loop") > 0 Then
            T = T - 1
            Debug.Print String(T, vbTab) & Trim(x)
        ElseIf InStr(1, x2, "Do") > 0 Then
            Debug.Print String(T, vbTab) & Trim(x)
            T = T + 1
        ElseIf InStr(1, x2, "End With") > 0 Then
            T = T - 1
            Debug.Print String(T, vbTab) & Trim(x)
        ElseIf InStr(1, x2, "With") > 0 Then
            Debug.Print String(T, vbTab) & Trim(x)
            T = T + 1
        ElseIf InStr(1, x2, "End If") > 0 Then
            T = T - 1
            Debug.Print String(T, vbTab) & Trim(x)
        ElseIf InStr(1, x2, "Else") > 0 Then
            T = T - 1
            Debug.Print String(T, vbTab) & Trim(x)
            T = T + 1
        ElseIf InStr(1, x2, "If ") > 0 Then
            Debug.Print String(T, vbTab) & Trim(x)
            T = T + 1
        ElseIf Trim(x) <> "" Then
            Debug.Print String(T, vbTab) & Trim(x)
        End If
    Next
End Sub

Function ConvertString(ByVal x As String) As String
    ConvertString = x
    If InStr(1, x, """") > 0 Then
        If InStr(1, x, "'") > 0 Then
            If InStr(1, x, """") < InStr(1, x, "'") Then
                ConvertString = InnerConvertString(x)
            End If
        Else
            ConvertString = InnerConvertString(x)
        End If
    End If
End Function

Private Function InnerConvertString(x As String) As String
    Dim newstr As String
    Dim IsString As Boolean
    For i = 1 To Len(x)
        IsString = (Mid(x, i, 1) = """") Xor IsString
        If Not IsString Then
            newstr = newstr & Mid(x, i, 1)
        End If
    Next
    InnerConvertString = newstr
End Function

整形出力されたFizzBuzz

Sub FizzBuzz()
    For i = 1 To 100
        If i Mod 15 = 0 Then
            Debug.Print "FizzBuzz"
        ElseIf i Mod 3 = 0 Then
            Debug.Print "Fizz"
        ElseIf i Mod 5 = 0 Then
            Debug.Print "Buzz"
        Else
            Debug.Print i
        End If
    Next
End Sub

課題

とりあえず、If、For、Do文には対応させたが、Select文などは対応していないし、DoEventをDoと間違ってしまうなど色々と問題は孕んでいる。また手の空いたときにでも正規表現を使う形に直そうかと思う。また、Debug.Printもまとめられるハズだが、インデントを下げてから出力するケース(End Ifなど)と、出力してから次の行に備えてインデントを増やすケース(Ifなど)があり、ややこしかったのでとりあえず全状況判断にDebug.Printを書いた。変数宣言も必要最低限しかしていない。

細部でつまずいて長考に陥ると、最初に浮かんだ全体ロジックのアイデアが頭から吹き飛んでしまうため、取りあえず力技で最後まで書ききってから整理するスタンスである。

なお、空行は削除する仕様にしてあるが、最後のElseIfをElseに書き換えれば空行も出力される。

【空行破棄】

        ElseIf Trim(x) <> "" Then
            Debug.Print String(T, vbTab) & Trim(x)
        End If
    Next
End Sub

【空行も出力】

        Else
            Debug.Print String(T, vbTab) & Trim(x)
        End If
    Next
End Sub

まあ、コードは汚いながら、私がメンテしたかったコードに対してはうまく動作したので、目的は達した。
ちょっと今はこれを書き直す気力は起きないので、また今度にしようと思う。

※もし役立ちそうならご自由にお使いください。