グラフを描いたり、統計計算をさせたり、いろいろな処理を行う場合に、その都度、対象欄として表の中の特定の範囲を選択し直してやらせたい、ということがよくあります。
ここでは、特定のセルをダブルクリックして起点を指定し、その列の有効な行までの範囲を得る、というマクロを作ってみました。
このミソは2つ。ひとつは、指定された範囲の情報がビジュアルに表示されるとともに保存されること。
たとえば、次の図のように、6行目F列をダブルクリックすると、そこから下の欄が指定されたことになり、その範囲の塗り色が(ここでは青く)変わることで結果が目に見えること。さらにその情報が "TopRow","EndRow","Column" という名前のついたセルに保存されること(この保存先はわかりやすいように表と同じワークシートに配置していますが、もちろん別の作業用ワークシートに配置したほうがエレガントな場合もあります)。
もうひとつのミソは、対象欄を選択することと、表の中を編集することとはフェーズが異なるので、ダブルクリックの機能をそれぞれ分けなくてはいけないこと。ここでは、「対象欄の指定」ボタンをクリックすると選択モードになり、そのことを告げるユーザーフォームが表示され、その完了ボタンを押すことで編集モードに戻る、という仕掛けにしました。
このモードは、InClassFlag というフラグで切り替えています。
ユーザーフォーム InstructionForm
Private Sub OKCommandButton_Click() Unload Me End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) InClassFlag = False End Sub
そこで問題なのは、このユーザーフォーム InstructionForm を表示している間に、ワークシートのダブルクリックを受け付けなくてはならないこと。InstructionForm.Show vbModal で表示すると、このフォームを閉じるまでワークシートにアクセスすることができません。vbModeless で表示すると、表示している間にアクセスができますが、マクロの実行はどんどん次に進んでしまいます。
それをうまく回避する方法はいくつかありそうですが、ここでは標準モジュールの サブルーチン instructionMessage にあるように、InClassFlag が降りるまで表示を続け、その間にワークシートのイベントを受け付けるようにしました。
基本的な構成は、そんなに複雑ではありません。ワークシートの BeforeDoubleClick イベントを受けつけて、そのイベントの発生したセルのオブジェクトを標準モジュールの ReceiveTopCell に渡し、そこで記録やセルの色塗りを行う、というものです。
ワークシート
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) If Not InClassFlag Then Exit Sub target.Offset(1, 0).Select ReceiveTopCell target End Sub
標準モジュール
'----- 指定作業中を示すフラグ(授業中) Public InClassFlag As Boolean '----- 指定されたレンジの塗りつぶし色 Private Const targetRangeColorIndex = 34 '----- 指定レンジを記録するセルの名前 Private Const topRowCellName = "TopRow" Private Const endRowCellName = "EndRow" Private Const targetColumnCellName = "Column" '----- 指定開始ボタンで呼び出すマクロ Public Sub StartSelectTopCell() InClassFlag = True instructionMessage "対象とするセル範囲の" & vbCrLf & _ "先頭をダブルクリックしてください。" End Sub '----- セルのダブルクリックで呼び出すマクロ Public Sub ReceiveTopCell(target) If Not InClassFlag Then Exit Sub limitLocation clearRangeColor topRow = target.row targetColumn = target.column limitLocation paintRangeColor targetRangeColorIndex End Sub '----- 指定する範囲を限定、endRow を計算 Private Sub limitLocation() If targetColumn < 4 Then targetColumn = 4 If topRow < 4 Then topRow = 4 With ActiveSheet endRow = .Cells(.Rows.count, targetColumn).End(xlUp).row End With End Sub '----- 指定されたレンジの塗りつぶし色を設定/消去 Private Sub paintRangeColor(cIndex) With ActiveSheet .Range(.Cells(topRow, targetColumn), .Cells(endRow, targetColumn)). _ Interior.ColorIndex = cIndex End With End Sub Private Sub clearRangeColor() paintRangeColor 0 End Sub '----- 入力指示メッセージ 'vbModeless ながら、閉じるまで次に移動しない Private Sub instructionMessage(msg) With InstructionForm .InstructionLabel.Caption = msg .Show vbModeless End With Do While InClassFlag: DoEvents: Loop End Sub '----- 現在の指定レンジを取得/記録 'ここでは、仮に ActiveSheet に記録欄を確保している Private Property Get topRow() topRow = ActiveSheet.Range(topRowCellName).value End Property Private Property Let topRow(row) ActiveSheet.Range(topRowCellName).value = row End Property Private Property Get endRow() endRow = ActiveSheet.Range(endRowCellName).value End Property Private Property Let endRow(row) ActiveSheet.Range(endRowCellName).value = row End Property Private Property Get targetColumn() targetColumn = ActiveSheet.Range(targetColumnCellName).value End Property Private Property Let targetColumn(column) ActiveSheet.Range(targetColumnCellName).value = column End Property