お絵かきロジックアナライザ開発記   その6

ユーザーからは直接見えないシートを設置し、そこにリセットされて欲しくない情報を保存するところまで来ました。しかしThisWorkbook.Sheets("System").Range("A1").Value = .... なんてRangeオブジェクトで記述していると、ただの‘記号’で解り辛いですよネ。どのような情報が収められているかをもっと直感的に捉えられるように、変数名のようにセルを別名化したいところです。例えば数式バー表示状態の保存先であるRange("A1")であれば‘FormulaBarSetting’のような名前で扱うことができた方が、プログラムを読みやすくなります。

セルに名前を付けるにはメニューから[挿入]→[名前]→[定義]を実行する方法が思い付きます。これはブックのNamesコレクションでAddメソッドを実行することに相当します。

しかしセルに付けた名前は、ワークシート上からも操作ができてしまいます。プロテクトを掛ける予定なので気にしないのも「あり」ですが、そもそもNameオブジェクトのAddメソッドは何も名前のないセルに名前を付けるモノで、間違った名前であっても既に名前があれば上書きされるワケではありません。マクロ実行の度に(既に名前があるにも関わらず)無意味なAddメソッドを実行するのもシャクに触ります。やろうとしているのはVBA上でしか必要のない‘別名化’なので、ここでは別の方法を採ることにします。具体的にはFunctionプロシージャを使って、まるで変数のように代入文を書くとセル内容が変更されるようにしていきます。

Rangeオブジェクトを別名参照

Rangeオブジェクトを別名化してVBAコード上で直感的に解り易くしたい。しかもその「名前」はVBAコード上でのみ有効なものにしたい。そんな要求に対して最初に思い付くのはオブジェクト変数を使う方法です。Setステートメントで対象セルを参照すれば、後はそのオブジェクト変数を使って対象セルを操作できます。しかしオブジェクト変数もマクロリセットでクリアされてしまう変数であることには変りません。保存情報があっても、そこに辿り着く参照情報が壊れてしまっては意味がないですよね。かといって参照の度にSetステートメントを使っていてはスマートさに掛けるし、オブジェクト参照する「定数」というものも見当らないし、でセル参照はFunctionプロシージャを利用して“本体プログラムからは離れたところのコード内に埋込む”コトにしました。

Rangeオブジェクトを返すFunction

前述の‘ThisWorkbook.Sheets("System").Range("A1").Value =’を詳説すればThisWorkbookプロパティを参照することでプロジェクトの存在するWorkbookオブジェクトを得ます。次にThisWorkbookオブジェクトのSheetsプロパティによりThisWorkbook内のSheetsコレクションを得て、("System")というアイテム指定によってSystemという特定の名前を持つSheetオブジェクトを得ます。Systemという名前が付いたSheetオブジェクトのRangeプロパティを参照することでRangeオブジェクトを取得し、そのValueプロパティに値を代入する、というコードになっています(あ〜メンドくさ)。

今からやろうとしているのはSystemWorksheet関数を作り、それを利用すればThisWorkbook.Sheets("System")オブジェクトが得られるようにするというコトです。同様にFormulaBarSetting関数でThisWorkbook.Sheets("System").Range("A1")オブジェクトを得るというストーリーです。

NonoModuleモジュール末尾に以下のコードを記述して下さい。

Function SystemWorksheet() As Worksheet
' Systemシートオブジェクト
  Set SystemWorksheet = ThisWorkbook.Sheets("System")
End Function

Function NonoWorksheet() As Worksheet
' Nonogramシートオブジェクト
  Set NonoWorksheet = ThisWorkbook.Sheets("Nonogram")
End Function

Function FormulaBarSetting() As Range
' 数式バー設定
  Set FormulaBarSetting = SystemWorksheet.Range("A1")
End Function

Function CellMoving() As Range
' セル移動設定
  Set CellMoving = SystemWorksheet.Range("A2")
End Function

Function CellMoveDirection() As Range
' セル移動方向設定
  Set CellMoveDirection = SystemWorksheet.Range("A3")
End Function

プロジェクト内で使用できる別名オブジェクトが5つ追加されました。ではThisWorkbookのブックアクティブイベントプロシージャを次のように変更してみましょう。

Private Sub Workbook_Activate()
' ブックアクティブイベント
  NonoModule.SystemSheetDisable                   'システムシート非表示
  With Application                                'オプション情報取得
    FormulaBarSetting = Application.DisplayFormulaBar
    CellMoving = Application.MoveAfterReturn
    CellMoveDirection = Application.MoveAfterReturnDirection
  End With
  With Application                                'オプション情報設定
    .DisplayFormulaBar = False
    .MoveAfterReturn = False
  End With
  With ActiveWindow                               'シートオプション設定
    .DisplayHeadings = False
    .DisplayWorkbookTabs = False
  End With
End Sub

1行目にブレークポイントを設置してブックの切替を行い、F8キーでステップ実行すると、別名オブジェクトの参照がある度にFunctionプロシージャを呼出している様子が見て取れます。ちなみにコード記述の厳密さを保つには‘FormulaBarSetting.Value =’のようにValueプロパティを伴った記述をすべきなのですが、FormulaBarSettingという名前の変数のような扱いという目的から遠離ってしまいます。RangeオブジェクトのデフォルトプロパティはValueなので、記述がなくても問題ありません。ここでは目をつぶって簡易記述を受入れておくこととします。

うまく動作することが確認できたらブック非アクティブイベントも同様に書替えておいて下さい。

Private Sub Workbook_Deactivate()
' ブック非アクティブイベント
  With Application                                'オプション情報復元
    Application.DisplayFormulaBar = FormulaBarSetting
    Application.MoveAfterReturn = CellMoving
    Application.MoveAfterReturnDirection = CellMoveDirection
  End With
End Sub

それでは続けてSystemシートのB列に収められたロジックシートサイズ情報もFunctionしておきましょう。

Function FieldWd() As Range
' フィールド幅
  Set FieldWd = SystemWorksheet.Range("B1")
End Function

Function FieldHt() As Range
' フィールド高
  Set FieldHt = SystemWorksheet.Range("B2")
End Function

Function HintWd() As Range
' 水平ヒント幅
  Set HintWd = SystemWorksheet.Range("B3")
End Function

Function HintHt() As Range
' 垂直ヒント高
  Set HintHt = SystemWorksheet.Range("B4")
End Function

仕上げにNonoModule内でWorksheetオブジェクトやRangeオブジェクト参照している部分を書替えておきます。またNewLogicSheetプロシージャ内ではWorkbookオブジェクトやWorksheetオブジェクトを省略して、いきなりRangeオブジェクトを書いていますが、ここもコードを厳密に記述しましょう。

Sub NewLogicSheet()
' 新規ロジックシート作成
  Dim FieldX As Integer                           'フィールドサイズ
  Dim FieldY As Integer
  Dim HintX As Integer                            'ヒントサイズ
  Dim HintY As Integer
  Dim StartPos As Integer                         '太線描画ポインタ
  Dim EndPos As Integer
  FieldX = SetFieldSize.FieldWidth.Value          'フィールドサイズ取得
  FieldY = SetFieldSize.FieldHeight.Value
  HintX = (FieldX + 1) \ 2                        'ヒントサイズ算出
  HintY = (FieldY + 1) \ 2
  With ThisWorkbook.Sheets("System")
    .Range("B1").Value = FieldX                   'フィールドサイズ取得
    .Range("B2").Value = FieldY
    .Range("B3").Value = HintX                    'ヒントサイズ算出
    .Range("B4").Value = HintY
  End With
  FieldWd = FieldX                                'フィールドサイズ保存
  FieldHt = FieldY
  HintWd = HintX                                  'ヒントサイズ保存
  HintHt = HintY
  Unload SetFieldSize                             'フォーム消去
  With NonoWorksheet
    .Cells.Delete                                 '編集領域クリア
    With .Cells
      .RowHeight = 12                             '行高/列幅調整
      .ColumnWidth = 1.4
    End With
    With .Range(.Cells(HintY + 1, 1) _
      , .Cells(HintY + FieldY, HintX))            '水平ヒントエリア
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
      .Interior.ColorIndex = 36
      .Interior.Pattern = xlSolid
    End With
    With .Range(.Cells(1, HintX + 1) _
      , .Cells(HintY, HintX + FieldX))             '垂直ヒントエリア
      .Borders(xlInsideVertical).LineStyle = xlContinuous
      .Interior.ColorIndex = 36
      .Interior.Pattern = xlSolid
    End With
    .Range(.Cells(HintY + 1, HintX + 1) _
      , .Cells(HintY + FieldY, HintX + FieldX)) _
      .Borders.LineStyle = xlContinuous           'フィールドエリア
    For StartPos = 1 To FieldY Step 5             '横太線描画
      EndPos = StartPos + 4
      If EndPos > FieldY Then EndPos = FieldY
      .Range(.Cells(StartPos + HintX, 1) _
        , .Cells(EndPos + HintY, HintX + FieldX)) _
        .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    Next StartPos
    For StartPos = 1 To FieldX Step 5             '縦太線描画
      EndPos = StartPos + 4
      If EndPos > FieldX Then EndPos = FieldX
      .Range(.Cells(1, StartPos + HintX) _
        , .Cells(HintY + FieldY, EndPos + HintX)) _
        .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    Next StartPos
    .Range(.Cells(1, 1), .Cells(HintX, HintY)) _
      .Interior.ColorIndex = 15                   '左上無効領域
  End With
End Sub

Sub SystemSheetDisable()
' システムシート非表示
  NonoWorksheet.Activate                          'ロジックシートアクティブ
  SystemWorksheet.Visible = xlSheetVeryHidden     'システムシート非表示
End Sub

Sub SystemSheetEnable()
' システムシート表示
  With SystemWorksheet                            'システムシート表示
    .Visible = xlSheetVisible
    .Activate
  End With
End Sub

FieldSizeDialogを実行して動作に異常がないか確認しておきましょう。これで“強固な”情報保存システムが完成しました。

ちょっとした後始末

モジュール間でプロシージャ呼出時の引数などを使わずに情報のやりとりができるようになったところで、今まで敢えて黙認していた「気に入らない部分」を修正しておきます。

FieldSizeDialogを実行するとSetFieldSizeフォームを表示し、フォームのOkClick_ClickイベントプロシージャがNonoModule内のNewLogicSheetプロシージャを呼出します。NewLogicSheetでは必要な処理を行った後、SetFieldSizeフォームを消去するという流れです。ここで何かおかしいと思うのは私だけでしょうか。SetFieldSizeフォームをその子プロセスであるNewLogicSheetプロシージャで消去するなんてヘンじゃないですか?(もちろんロジックシートを作ってからSetFieldSizeフォームに戻り、そこでUnloadでフォームを消去してもいいのですが、前述のSetFocusの時と同様‘こだわり’の結果ですね)。やはり当初の「SetFieldSize内にUnload Meステートメントが存在するカタチ」の方が自然です。ただし先にフォームをアンロードしてしまってから、そのフォーム上にあるフィールドサイズ情報を取得するワケにはいかないため、取得が必要なNewLogicSheetプロシージャ実行までフォーム消去を控えていたのです。SetFieldSize内でUnloadするには、SetFieldSizeでシートサイズを取得し、それをNewLogicSheet呼出時に引数として渡してやればいいのですが、4つも引数を伴うプロシージャ呼出しは何ともゴチャゴチャしている感が拭えません。後の解析プロセスでサイズ情報が必要になってくるため、苦労してセルに保存するトコロまで行き着いたので、SetFieldSizeとNewLogicSheetとの間でもこの保存システムを利用しましょう。

つまりSetFieldSizeでサイズ情報取得とセルへの保存まで終わらせた上でUnload Meを実行し、フォーム消去後にNewLogicSheetプロシージャを呼出します。NewLogicSheetプロシージャではセルに保存されているサイズ情報を読出し、それを利用して新規シート描画を行います。引っ越し作業の「一部出戻り」ですね。

それではSetFieldSizeのOKクリックイベントにフォーム消去までのプロセスを追加します。

Private Sub OkClick_Click()
' OKクリックイベント
  With Me
    If FieldWidth.Text = vbNullString Then        '横サイズ欄チェック
      .Message.Caption = "サイズが設定されていません。"
      .FieldWidth.SetFocus
      Exit Sub
    End If
    If FieldWidth.Text = vbNullString Then        '縦サイズ欄チェック
      .Message.Caption = "サイズが設定されていません。"
      .FieldHeight.SetFocus
      Exit Sub
    End If
    FieldWd = .FieldWidth.Value                   'フィールドサイズ保存
    FieldHt = .FieldHeight.Value
    HintWd = (FieldWd + 1) \ 2                    'ヒントサイズ保存
    HintHt = (FieldHt + 1) \ 2
  End With
  Unload Me                                       'フォーム消去
  NonoModule.NewLogicSheet                        '新規シート作成
End Sub

それではNewLogicSheetプロシージャで不要になった部分を削除します。

Sub NewLogicSheet()
' 新規ロジックシート作成
  Dim FieldX As Integer                           'フィールドサイズ
  Dim FieldY As Integer
  Dim HintX As Integer                            'ヒントサイズ
  Dim HintY As Integer
  Dim StartPos As Integer                         '太線描画ポインタ
  Dim EndPos As Integer
  FieldX = FieldWd                                'フィールドサイズ取得
  FieldY = FieldHt
  HintX = HintWd                                  'ヒントサイズ取得
  HintY = HintHt
  FieldWd = FieldX                                'フィールドサイズ取得
  FieldHt = FieldY
  HintWd = HintX                                  'ヒントサイズ算出
  HintHt = HintY
  Unload SetFieldSize                             'フォーム消去
  With NonoWorksheet
    .Cells.Delete                                 '編集領域クリア
    ....

フィールドサイズ情報の受渡しも、保存情報からローカル変数に転送したものをプロシージャ内で利用するという順当な流れになっています。ところでここまで来るとFieldXなどのローカル変数も最早不要で、FieldWdなどを直接参照すればよいことに気付きます(ループ内参照などでは実行速度に差が出ますが)。思い切ってコード全体から不要な変数を排除していきましょう。

Sub NewLogicSheet(Optional ByVal CallSwitch As Boolean)
' 新規ロジックシート作成
  Dim FieldX As Integer                           'フィールドサイズ
  Dim FieldY As Integer
  Dim HintX As Integer                            'ヒントサイズ
  Dim HintY As Integer
  Dim StartPos As Integer                         '太線描画ポインタ
  Dim EndPos As Integer
  FieldX = FieldWd                                'フィールドサイズ取得
  FieldY = FieldHt
  HintX = HintWd                                  'ヒントサイズ取得
  HintY = HintHt
  With NonoWorksheet
    .Cells.Delete                                 '編集領域クリア
    With .Cells
      .RowHeight = 12                             '行高/列幅調整
      .ColumnWidth = 1.4
    End With
    With .Range(.Cells(HintHt + 1, 1) _
      , .Cells(HintHt + FieldHt, HintWd))         '水平ヒントエリア
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
      .Interior.ColorIndex = 36
      .Interior.Pattern = xlSolid
    End With
    With .Range(.Cells(1, HintWd + 1) _
      , .Cells(HintHt, HintWd + FieldWd))         '垂直ヒントエリア
      .Borders(xlInsideVertical).LineStyle = xlContinuous
      .Interior.ColorIndex = 36
      .Interior.Pattern = xlSolid
    End With
    .Range(.Cells(HintHt + 1, HintWd + 1) _
      , .Cells(HintHt + FieldHt, HintWd + FieldWd)) _
      .Borders.LineStyle = xlContinuous           'フィールドエリア
    For StartPos = 1 To FieldHt Step 5            '横太線描画
      EndPos = StartPos + 4
      If EndPos > FieldHt Then EndPos = FieldHt
      .Range(.Cells(StartPos + HintHt, 1), _
        .Cells(EndPos + HintHt, HintWd + FieldWd)) _
        .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    Next StartPos
    For StartPos = 1 To FieldWd Step 5            '縦太線描画
      EndPos = StartPos + 4
      If EndPos > FieldWd Then EndPos = FieldWd
      .Range(.Cells(1, StartPos + HintWd), _
        .Cells(HintHt + FieldHt, EndPos + HintWd)) _
        .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    Next StartPos
    .Range(.Cells(1, 1), .Cells(HintHt, HintWd)) _
      .Interior.ColorIndex = 15                   '左上無効領域
  End With
End Sub

これでやっとスッキリした気分で次に進むことができます。

← 前へ   → 次へ ▲ ページトップ