546 棒グラフ・応用014 棒グラフ 縦罫線の正常化処理
前回、縦罫線が「間列戻」処理を実行すると不適切な場所に描画されてしまう現象が起きることが分かった。続けて「間列増」処理や「間列減」処理を行うと縦罫線の状態が可笑しな状態になることがあったので、全面的に縦罫線を「間列戻」、「間列増」、「間列減」の各処理の最後に描き直すマクロを用意した。マクロコードを先に掲載。(メモ目的で掲載。)Sub 棒グラフ柱上部両側縦罫線正常化マクロ()Application.ScreenUpdating = FalseDim Cp_R As Integer, Cp_C As IntegerDim Pp_R As Integer, Pp_C As IntegerDim trgt_C As IntegerDim i As Integer, j As IntegerDim PpCell As Range Cp_R = fnc_Cp_Pp(1) Cp_C = fnc_Cp_Pp(2) Pp_R = fnc_Cp_Pp(3) Pp_C = fnc_Cp_Pp(4) Set PpCell = Cells(Pp_R, Pp_C) PpCell.Select With Range(Cells(Cp_R, Cp_C), Cells(Pp_R - 1, Pp_C)) .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone End With i = 1 Do While i < Pp_C trgt_C = Cp_C + i If Len(Cells(Pp_R, trgt_C)) <> 0 Then j = 0 Do While Cells(Cp_R + j, trgt_C).Interior.Color = _ RGB(255, 255, 255) Or _ j > Pp_R - Cp_R j = j + 1 Loop With Range(Cells(Cp_R + j, trgt_C), Cells(Pp_R - 1, trgt_C)) .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeLeft).Weight = xlThin .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeRight).Weight = xlThin End With With Range(Cells(Cp_R + j, trgt_C), Cells(Pp_R - 1, trgt_C)) .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeLeft).Weight = xlThin .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeRight).Weight = xlThin End With End If i = i + 1 LoopEnd SubFunction fnc_Cp_Pp(Num As Integer) As IntegerDim i As Integer, j As IntegerDim Num_i1 As Integer, Num_i2 As IntegerDim Cp_R As Integer, Cp_C As IntegerDim Pp_R As Integer, Pp_C As IntegerDim Cp_Pp As String Cp_Pp = fnc_Clmn_GRph_Cp_Pp() Num_i1 = WorksheetFunction.Find("_", Cp_Pp, 1) Cp_R = Val(Mid(Cp_Pp, 1, Num_i1 - 1)) Num_i2 = WorksheetFunction.Find("_", Cp_Pp, Num_i1 + 1) Cp_C = Val(Mid(Cp_Pp, Num_i1 + 1, Num_i2 - Num_i1 - 1)) Num_i1 = Num_i2 Num_i2 = WorksheetFunction.Find("_", Cp_Pp, Num_i1 + 1) Pp_R = Val(Mid(Cp_Pp, Num_i1 + 1, Num_i2 - Num_i1 - 1)) Num_i1 = Num_i2 Num_i2 = Len(Cp_Pp) Pp_C = Val(Mid(Cp_Pp, Num_i1 + 1, Num_i2 - Num_i1)) For i = Cp_C To Pp_C If Len(Cells(Pp_R, i)) > 0 Then Exit For Next Select Case Num Case 1: fnc_Cp_Pp = Cp_R Case 2: fnc_Cp_Pp = Cp_C Case 3: fnc_Cp_Pp = Pp_R Case 4: fnc_Cp_Pp = Pp_C Case Else: fnc_Cp_Pp = 0 End SelectEnd FunctionFunction fnc_Clmn_GRph_Cp_Pp() As StringDim trgt_i As Integer, ttl_R As Integer, _ trgt_R As Integer, trgt_C As IntegerDim Lft_C As Integer, Rgt_C As IntegerDim i As Integer, Num_i As IntegerDim k As Long Call Initialize(2) Lft_C = pKey_Cell.Column + 3 + pMizo_C + 3 trgt_i = pKey_Cell.Row + pRw + pMizo_R trgt_R = trgt_i Do While Cells(trgt_i, Lft_C - 1 + 1). _ Interior.Color = RGB(255, 255, 255) And _ Cells(trgt_i, Lft_C - 1 + 1). _ Borders(xlEdgeBottom).LineStyle <> xlNone trgt_i = trgt_i + 1 If trgt_i = 1000 Then Exit Do End If Loop ttl_R = trgt_i trgt_i = Lft_C Do While Cells(ttl_R, trgt_i). _ Borders(xlEdgeTop).LineStyle <> xlNone trgt_i = trgt_i + 1 If trgt_i = 1000 Then Exit Do End If Loop Rgt_C = trgt_i - 1 fnc_Clmn_GRph_Cp_Pp = trgt_R & "_" & Lft_C & _ "_" & ttl_R & "_" & Rgt_CEnd Function下記の状態から「棒グラフ柱上部両側縦罫線正常化マクロ」を実行する。【実行後】別のパターンで下記の状態から「棒グラフ柱上部両側縦罫線正常化マクロ」を実行【実行後】上記の通り、罫線描画の正常化がなされることが実証されたので、「間列戻」、「間列増」、「間列減」の各処理の最後に「棒グラフ柱上部両側縦罫線正常化マクロ」を書き足せば、縦罫線の不適切な描画は起こらなくなります。つづく©2020 みさき式エクセルマクロ