Excelで数式が入っているセルを探して印をつけるマクロ Ver0.02

前に書いた(Excelで数式が入っているセルを探して印をつけるマクロ - Agrius_Akitaの日記)数式を探すマクロをちょっと改善
完全に文字列(【R11.C11】)にすると、一括選択ができないので。
数式(="【R11.C11】")に変換するようにしてみた。


機能番号6番追加〜

Option Explicit

' ==================================================
' ■数式チェック
'   処理内容を決める
' ==================================================
Sub mcrFormulaChange()

    Dim flgDo As String


' -------------------------
' 処理内容の選択と実行
' -------------------------
    flgDo = InputBox( _
                Prompt:="数式セルをどうするか決めて、処理番号を入れて下さい" & vbNewLine & _
                        vbNewLine & _
                        "【1】:セルの背景色を変える" & vbNewLine & _
                        "【2】:セルを罫線で囲う" & vbNewLine & _
                        "【3】:数式を「行・列番号」へ置き換える" & vbNewLine & _
                        "【4】:1と2を実行" & vbNewLine & _
                        "【5】:1〜3を全て実行", _
                        "【6】:[β版]行列置換結果を計算式に", _
                Title:="処理の選択")

    ' エラーチェック
    Select Case StrConv(flgDo, vbNarrow)
        ' 正しく入力している場合は処理開始
        Case "1"
            Call subFormulaChange_Select(flgDo)
        Case "2"
            Call subFormulaChange_Select(flgDo)
        Case "3"
            Call subFormulaChange_Select(flgDo)
        Case "4"
            Call subFormulaChange_Select(flgDo)
        Case "5"
            Call subFormulaChange_Select(flgDo)
        Case "6"
            Call subFormulaChange_Select(flgDo)
        ' それ以外の場合は終了
        Case Else
            Call MsgBox(Prompt:="処理を中止します")
            End
    End Select

End Sub

' ==================================================
' ■数式チェック
'   選択範囲の数式セルへ印をつける
' ==================================================
Sub subFormulaChange_Select(flgDo As String)

    Dim cleRange    As New Collection
    Dim rngInput    As Range
    Dim rngCell     As Range
    Dim rngArea     As Range
    Dim lngCol      As Long
    Dim lngRow      As Long


' -------------------------
' 置換範囲の選択
' -------------------------
    ' キャンセル時のデータエラーを無視
    On Error Resume Next

        ' 数式を探すセル範囲を選択
        ' 既にセル選択している場合はデフォルトで入力しておく
        Set rngInput = Application.InputBox( _
                        Prompt:="数式セルを探す範囲を選択してください", _
                        Title:="数式セルを探す範囲の選択", _
                        Default:=Selection.Address(RowAbsolute:=False, ColumnAbsolute:=False), _
                        Type:=8)

    ' ★キャンセルチェック
    On Error GoTo 0
    If rngInput Is Nothing Then
        Call MsgBox(Prompt:="処理を中止します")
        End
    End If


    ' マクロ実行中の画面描写をOFF
    ' InputBoxの動きを良くするため、ここでOFFにする。
    Application.ScreenUpdating = False

    ' ループ用にセル範囲を取得
    With cleRange
        ' 開始列
        .Add Item:=rngInput.Column, Key:="ColStart"
        ' 開始行
        .Add Item:=rngInput.Row, Key:="RowStart"
        ' 終了列
        .Add Item:=rngInput.Column + rngInput.Columns.Count - 1, Key:="ColEnd"
        ' 終了行
        .Add Item:=rngInput.Row + rngInput.Rows.Count - 1, Key:="RowEnd"
    End With


' -------------------------
' 選択範囲の各セルが数式かチェック
' -------------------------
    ' 列ループ
    For lngCol = cleRange("ColStart") To cleRange("ColEnd")

        ' 行ループ
        For lngRow = cleRange("RowStart") To cleRange("RowEnd")

            ' 処理セルを設定
            Set rngCell = Cells(lngRow, lngCol)

            ' 数式か判断
            If rngCell.HasFormula Then

                ' 結合セル全体を選択
                Set rngArea = rngCell.Resize(rngCell.MergeArea.Rows.Count, rngCell.MergeArea.Columns.Count)

                Select Case StrConv(flgDo, vbNarrow)
                    Case "1"
                        ' 色を付ける
                        rngArea.Interior.Color = RGB(120, 180, 240)
                    Case "2"
                        ' セルを囲う
                        With rngArea.Borders
                            .LineStyle = xlContinuous
                            .Color = RGB(255, 0, 0)
                            .Weight = xlMedium
                        End With
                    Case "3"
                        ' 何行目・何列目か置き換える
                        rngArea.Value = "【R" & lngRow & ".C" & lngCol & "】"
                    Case "4"
                        ' 色を付ける
                        rngArea.Interior.Color = RGB(120, 180, 240)
                        ' セルを囲う
                        With rngArea.Borders
                            .LineStyle = xlContinuous
                            .Color = RGB(255, 0, 0)
                            .Weight = xlMedium
                        End With
                    Case "5"
                        ' 色を付ける
                        rngArea.Interior.Color = RGB(120, 180, 240)
                        ' セルを囲う
                        With rngArea.Borders
                            .LineStyle = xlContinuous
                            .Color = RGB(255, 0, 0)
                            .Weight = xlMedium
                        End With
                        ' 何行目・何列目か置き換える
                        rngArea.Value = "【R" & lngRow & ".C" & lngCol & "】"
                    Case "6"
                        ' 色を付ける
                        rngArea.Interior.Color = RGB(120, 180, 240)
                        ' セルを囲う
                        With rngArea.Borders
                            .LineStyle = xlContinuous
                            .Color = RGB(255, 0, 0)
                            .Weight = xlMedium
                        End With
                        ' 何行目・何列目か置き換える
                        rngArea.Value = "=" & """【R" & lngRow & ".C" & lngCol & "】"""
                    Case Else
                        ' 何もしない
                End Select
            End If

        Next lngRow

    Next lngCol

    ' マクロ実行中の画面描写を戻す
    Application.ScreenUpdating = True

End Sub