495「どうなる『前回比較版明細付き帯グラフ』、その運命は如何に！？」第６２話

「前比帯g」ボタンのコードを掲載します。

但し、呼び出しているマクロのコードを

全て掲載することは断念しており

虫食いの解答例を提示して

マクロ名からどのようなマクロかを

想像してもらうこととなります。

また、「前比帯g」ボタンを押した時、

及び

「前比帯g」ボタンを押した時に

入力表の左３列目から

グラフの白枠の列までを

削除する処理を行うために

複数の対象列を選択するための

Functionプロシージャ

「fnc_Columnz(cln1, cln2)」

を用意しており、

このマクロは汎用性が高く、

簡単に連続する複数列を示す文字列を

値(文字列)を返す優れもの。

複数列を選択する方法について、

どう処理するか、

これまで頭の悩ましていたので

ここで個別にコードを

掲載しておくことしました。

この「fnc_Columnz(cln1, cln2)」を

使うにあたり、

二番目の引数　「cln2」は

ヤンバルグラフの

右端の白枠の列番地(数値)を

代入することになりますが(※) 、

この列番号を返す　

Functionプロシージャーも

別途、用意したので、今回掲載しています。

(※　グラフが描画されている場合)

但し、このマクロは量率グラフ作成にあたり

用意しているPulbic変数を利用した

もののため汎用性はありません。

Private Sub 前比帯gButton39_Click()

    If ActiveCell.Address <> _
Selection.Cells(1).Address And _
Selection.Rows.Count = 2 And _
   Selection.Columns.Count = 2 Then
        If ActiveCell.Address = _
            Selection.Cells(Selection.Columns.Count). _
        Address Then '右上角
            CommandButton39.ForeColor = _　

&HFF& '赤

ElseIf ActiveCell.Address = _
            Selection.Cells(Selection.Columns.Count * _
                            Selection.Rows.Count). _
　　　 Address Then '右下角
     CommandButton39.ForeColor = _
　　　 &H8000000D          '青
       ElseIf ActiveCell.Address = _
            Selection.Cells _
　　　 ((Selection.Columns.Count - 1) * _
                  Selection.Rows.Count + 1). _
               Address Then '左下角

             CommandButton39.ForeColor = _
　　　 &HC0C0&             '黄
        End If
    ElseIf Selection.Rows.Count >= 3 And _
　　 Selection.Columns.Count >= 2 Then

        If ActiveCell.Address = _
            Selection.Cells(Selection.Columns.Count). _
　　 Address Then '右上角
             CommandButton39.ForeColor = _
&HC000C0               '紫

        ElseIf ActiveCell.Address = _
            Selection.Cells(Selection.Columns.Count * _
                            Selection.Rows.Count). _
　　 Address Then '右下角
             CommandButton39.ForeColor = _
                &HC000&             '緑
End If

Exit Sub
End If

clr = UserForm.CommandButton39.ForeColor

Dim Lst_cln As Integer

Select Case clr

Case &H8000000D '青

           Call a横バージョン_量率グラフ色付けあり
           Call コンパクト版仕上げ準備
           Call コンパクト版_シアゲ
Case &HC0C0&            '黄
           Call a横バージョン_量率グラフ色付けあり
           Call コンパクト版仕上げ準備
      Case &HC000C0     '紫

Initialize (2)

Lst_cln = kijun_cell_func2()

Columns( _

fnc_Columnz(pKey_Cell.Column - 3, Lst_cln) _

).Delete

UserForm.CommandButton117.ForeColor = _
&HFF& '赤

         Call CommandButton117_Click
   CommandButton19.ForeColor = _
            &HFF0000         '紫紺

         Call CommandButton19_Click
   CommandButton39.ForeColor = _
            &H8000000D       '青
   Call a横バージョン_量率グラフ色付けあり
         Call コンパクト版仕上げ準備
         Call コンパクト版_シアゲ
   Case &HC000&      '緑
   Initialize (2)
   UserForm.CommandButton117.ForeColor = _

              &HFF&              '赤
         Call CommandButton117_Click
   CommandButton19.ForeColor = _
             &HFF0000            '紫紺
         Call CommandButton19_Click
   CommandButton27.ForeColor = _
             &HFF&               '赤
         Call CommandButton27_Click
   CommandButton39.ForeColor = _
             &H8000000D          '青

         Call a横バージョン_量率グラフ色付けあり
         Call コンパクト版仕上げ準備
         Call コンパクト版_シアゲ
　 Case &HFF&              '赤

If UserForm.CheckBox17 = False And _
           UserForm.TextBox07 <> 600 Then
   rep = MsgBox("ユーザフォームに横グ縮小係数を　" & _
                            Chr(10) & Chr(10) & _
                        "　　　　　　" & 600 & "　に設定しますか?", _
                        vbYesNo)
          If rep = vbYes Then
              UserForm.TextBox07 = 600
          End If
        End If
        If UserForm.CheckBox17 = True Then
          UserForm.TextBox07 = 600
        End If

        '量率グラフ横バージョン作成
        Call CommandButton4_Click
    End Select

Call エラーを無視する表示の消去

End Sub

Function fnc_Columnz(cln1 As Integer, _
cln2 As Integer) As String

Dim adrs1 As String, adrs2 As String
Dim num As Integer

    adrs1 = Columns(cln1).Address
    num = WorksheetFunction.Find(":", adrs1, 1)
    adrs1 = Mid(adrs1, 1, num - 1)

    adrs2 = Columns(cln2).Address
    num = WorksheetFunction.Find(":", adrs2, 1)
    adrs2 = Mid(adrs2, 1, num - 1)

fnc_Columnz = adrs1 & ":" & adrs2

End Function

※以下のFuncitonプロシージャーでは、

　　Public 変数いくつか使用しており、

　　またプライベート関数のInitilize()も

　　使用しているため、

　　下記を単独で使っても使用することは

　　できません。

　　Initilize()関数については、

　　No. 377にコードを掲載済です。

Function kijun_cell_func2() As Integer
Call Initialize(2)

    E_row = pKey_Cell.Row + pNum_Ctgy * 8 - 2 - 1
    Cells(E_row + pMizo_R + 2, pKey_Cell.Column + 3 + pMizo_C + 1).Activate
    If Len(ActiveCell) = 0 Then
        kijun_cell_func2 = 200
        Exit Function
    End If
    Do

        ActiveCell.Offset(0, 1).Activate
        i = i + 1
        k = k + 1
    Loop Until ActiveCell.Interior.Color =

RGB(255, 255, 255) Or i = 1000
    If i = 1000 Then
        kijun_cell_func2 = 200
        MsgBox ("「第一 Do ～ Loop」オーバーフロー終了")
        Exit Function
    End If

kijun_cell_func2 = ActiveCell.Column

End Function

つづく