'モジュールでインデントとコメントを挿入削除するマクロ2(Excel95)

'「クリップボードへのテキストデータ入出力を行う関数(Excel95)」が必要です。
'Personal.xlsに作成して、ツールバーボタンに登録して使うと便利かも。

Option Explicit

'インデントを挿入するマクロ
Sub InsertIndent()

    'クリップボードのクリア
    If Not ClipboardClear Then
        MsgBox "クリップボードをクリアできません。", vbExclamation
        Exit Sub
    End If

    'モジュールシートの選択範囲をコピーします。
    'SendKeysは実際にはこのマクロが終了してから処理されます。
    SendKeys "^c"

    'このマクロ終了後にステートメントを編集するマクロを起動します。
    Application.OnTime Now, "'EditModuleLine 1'"
End Sub

'インデントを削除するマクロ
Sub DeleteIndent()
    If Not ClipboardClear Then
        MsgBox "クリップボードをクリアできません。", vbExclamation
        Exit Sub
    End If
    SendKeys "^c"
    Application.OnTime Now, "'EditModuleLine 2'"
End Sub

'コメント記号を挿入するマクロ
Sub InsertRem()
    If Not ClipboardClear Then
        MsgBox "クリップボードをクリアできません。", vbExclamation
        Exit Sub
    End If
    SendKeys "^c"
    Application.OnTime Now, "'EditModuleLine 3'"
End Sub

'コメント記号を削除するマクロ
Sub DeleteRem()
    If Not ClipboardClear Then
        MsgBox "クリップボードをクリアできません。", vbExclamation
        Exit Sub
    End If
    SendKeys "^c"
    Application.OnTime Now, "'EditModuleLine 4'"
End Sub

'ステートメントを編集するマクロ
Sub EditModuleLine(iIndex As Integer)
    Const sEditModuleSheet As String = "EditModule"
    Dim vFormats As Variant
    Dim sCRLF As String, sRem As String, sSpace As String, sIndent As String
    Dim sInput As String, sOutput As String
    Dim iStart As Long, iNext As Long
    Dim iCount As Long
    Dim vRet As Variant
    Dim i As Long
    Dim s As String

    sCRLF = Chr$(13) & Chr$(10)
    sRem = "'"
    sSpace = " "
    sIndent = String$(4, " ")

    'クリップボードがテキスト形式のときだけ処理を続行します
    vFormats = Application.ClipboardFormats
    If LBound(vFormats) <> UBound(vFormats) Then Exit Sub
    If vFormats(LBound(vFormats)) <> xlClipboardFormatText Then Exit Sub

    vRet = GetClipboardText()
    If VarType(vRet) = vbBoolean Then
        MsgBox "クリップボードテキストの取得でエラーが発生しました。", vbExclamation
        Exit Sub
    End If
    sInput = vRet
    sOutput = ""

    '編集処理
    Select Case iIndex

        'インデントの挿入
        Case 1
            iCount = 0
            iStart = 1
            Do While iStart <= Len(sInput)
                iCount = iCount + 1
                iNext = InStr(iStart, sInput, sCRLF, 0)
                If iNext = 0 Then
                    s = Mid$(sInput, iStart)
                    sOutput = sOutput & sIndent & s
                    Exit Do
                Else
                    s = Mid$(sInput, iStart, iNext - iStart)
                    sOutput = sOutput & sIndent & s & sCRLF
                    iStart = iNext + 2
                End If
            Loop

        'インデントの削除
        Case 2
            iCount = 0
            iStart = 1
            Do While iStart <= Len(sInput)
                iCount = iCount + 1
                iNext = InStr(iStart, sInput, sCRLF, 0)
                If iNext = 0 Then
                    s = Mid$(sInput, iStart)
                    For i = 1 To 4
                        If Mid$(s, i, 1) <> sSpace Then Exit For
                    Next
                    sOutput = sOutput & Mid$(s, i)
                    Exit Do
                Else
                    s = Mid$(sInput, iStart, iNext - iStart)
                    For i = 1 To 4
                        If Mid$(s, i, 1) <> sSpace Then Exit For
                    Next
                    sOutput = sOutput & Mid$(s, i) & sCRLF
                    iStart = iNext + 2
                End If
            Loop

        'コメント記号の挿入
        Case 3
            iCount = 0
            iStart = 1
            Do While iStart <= Len(sInput)
                iCount = iCount + 1
                iNext = InStr(iStart, sInput, sCRLF, 0)
                If iNext = 0 Then
                    s = Mid$(sInput, iStart)
                    For i = 1 To Len(s)
                        If Mid$(s, i, 1) <> sSpace Then Exit For
                    Next
                    If i <= Len(s) Then
                        sOutput = sOutput & Left$(s, i - 1) & sRem & Mid$(s, i)
                    Else
                        sOutput = sOutput & sRem & s
                    End If
                    Exit Do
                Else
                    s = Mid$(sInput, iStart, iNext - iStart)
                    For i = 1 To Len(s)
                        If Mid$(s, i, 1) <> sSpace Then Exit For
                    Next
                    If i <= Len(s) Then
                        sOutput = sOutput & Left$(s, i - 1) & sRem & Mid$(s, i) & sCRLF
                    Else
                        sOutput = sOutput & sRem & s & sCRLF
                    End If
                    iStart = iNext + 2
                End If
            Loop

        'コメント記号の削除
        Case 4
            iCount = 0
            iStart = 1
            Do While iStart <= Len(sInput)
                iCount = iCount + 1
                iNext = InStr(iStart, sInput, sCRLF, 0)
                If iNext = 0 Then
                    s = Mid$(sInput, iStart)
                    For i = 1 To Len(s)
                        Select Case Mid$(s, i, 1)
                            Case sSpace
                            Case sRem
                                s = Left$(s, i - 1) & Mid$(s, i + 1)
                                Exit For
                            Case Else
                                Exit For
                        End Select
                    Next
                    sOutput = sOutput & s
                    Exit Do
                Else
                    s = Mid$(sInput, iStart, iNext - iStart)
                    For i = 1 To Len(s)
                        Select Case Mid$(s, i, 1)
                            Case sSpace
                            Case sRem
                                s = Left$(s, i - 1) & Mid$(s, i + 1)
                                Exit For
                            Case Else
                                Exit For
                        End Select
                    Next
                    sOutput = sOutput & s & sCRLF
                    iStart = iNext + 2
                End If
            Loop

        Case Else
    End Select

    '編集したステートメントをコピー
    If Not SetClipboardText(sOutput) Then
        MsgBox "テキストのコピーでエラーが発生しました。", vbExclamation
        Exit Sub
    End If

    'モジュールシートへ貼り付け、選択します
    SendKeys "^v+{UP " & CStr(iCount) & "}"

End Sub