罫線で立体を表現するには
ここでは、オートシェイプを使わずに罫線で立体表現をするマクロを紹介します。
このマクロですが、実際に私が資料を作る際に「オートシェイプを使わずに絵を表現するにはどうしたらよいか？」ということを考えたのがきっかけです。
私はExcelの資料を作る際に「資料作成」自体に時間が取られるのを好みません。どういう資料であるべきかなどの本質的な部分に時間をより多く使いたいことと、他に作業がある場合に資料作成自体に時間をかけられない、というのもあります。だからと言って、あとで見て分からないような雑な資料は作りたくない、というのもあります。
オートシェイプは絵を表現するには便利ですが、位置や微調整などに時間が取られやすいことと、テキストが文字列検索で引っかからないという難点があり、時間をかけずに資料を作りたい場合には使い勝手が悪い面があります。ついでに言えば、初期状態の青背景＋黒文字が気に入らない、ってのもあります。
そこで、上に書いた「オートシェイプを使わずに絵を表現するには？」ということを考えたときに、「別に絵じゃなくても絵っぽく見えればよくね？」→「絵といっても実際には四角の箱を並べてるのがほとんど」→「じゃあ罫線で箱を表現できれば十分」という発想に至りました。
以下がオートシェイプと罫線立体化の違いです。上がオートシェイプで下がマクロで立体的な罫線を引いた方です。分かりやすいようにグリッド線は消してます。
以下もマクロで罫線を引いて立体化していますが、この程度でよい資料でしたらオートシェイプを使う必要がなくなり資料作りは早く済みます。
罫線で立体表示するマクロ
以下のマクロは選択範囲のセルの外枠に立体的に見える罫線を引きます。
関数が２つありますが、実行するのは１つ目のSet3DLine()関数の方です。２つ目のAdjustColor()関数は色の濃い、薄いを調整する関数です。
コードは長いですが、やっていることは大したことをしていません。Bordersプロパティが上下左右の線の太さと種類と色をそれぞれ設定するためその分コードも長くなっています。
太線＋実線で、線の色は選択範囲の一番左上のセルの背景色を基準に、左上側を薄くして、右下側を濃くすることで立体っぽく見えるようにしています。なお、背景色が未設定のセルの場合は、グレーの枠線を付けるようにしています。
線はあえて外側にしか引かないようにしています。その理由は上のサンプルのように、箱の中に小箱があるような場合に小箱の線に影響しないように考慮してのことです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 |
Sub Set3DLine() Dim rs As Range '// 選択セル範囲 Dim r As Range '// セル（選択セル範囲の一番左上のセル） Dim iRed As Integer '// 赤 Dim iGreen As Integer '// 緑 Dim iBlue As Integer '// 青 Dim iColor As Long '// 色 Dim iRedLight As Integer '// 赤＋薄く Dim iGreenLight As Integer '// 緑＋薄く Dim iBlueLight As Integer '// 青＋薄く Dim iRedDark As Integer '// 赤＋濃く Dim iGreenDark As Integer '// 緑＋濃く Dim iBlueDark As Integer '// 青＋濃く '// 選択範囲の一番左上のセルを設定 Set rs = Selection Set r = rs(1) '// 左上セルの背景が白の場合 If r.Interior.Color = RGB(255, 255, 255) Or r.Interior.ColorIndex = xlNone Then '// 基準色としてグレーを設定 iColor = RGB(200, 200, 200) Else '// 基準色として左上セルの背景色を設定 iColor = r.Interior.Color End If '// Color値をRGBに分離 iRed = iColor Mod 256 iGreen = Int(iColor / 256) Mod 256 iBlue = Int(iColor / 256 / 256) '// 基準色より薄い色を設定 iRedLight = AdjustColor(iRed, 30) iGreenLight = AdjustColor(iGreen, 30) iBlueLight = AdjustColor(iBlue, 30) '// 基準色より濃い色を設定 iRedDark = AdjustColor(iRed, -30) iGreenDark = AdjustColor(iGreen, -30) iBlueDark = AdjustColor(iBlue, -30) '// 上下左右を太線 rs.Borders(xlEdgeLeft).Weight = xlThick rs.Borders(xlEdgeTop).Weight = xlThick rs.Borders(xlEdgeRight).Weight = xlThick rs.Borders(xlEdgeBottom).Weight = xlThick '// 上下左右を実線 rs.Borders(xlEdgeLeft).LineStyle = xlContinuous rs.Borders(xlEdgeTop).LineStyle = xlContinuous rs.Borders(xlEdgeRight).LineStyle = xlContinuous rs.Borders(xlEdgeBottom).LineStyle = xlContinuous '// 上と左を薄く、右と下を濃い色で設定 rs.Borders(xlEdgeLeft).Color = RGB(iRedLight, iGreenLight, iBlueLight) rs.Borders(xlEdgeTop).Color = RGB(iRedLight, iGreenLight, iBlueLight) rs.Borders(xlEdgeRight).Color = RGB(iRedDark, iGreenDark, iBlueDark) rs.Borders(xlEdgeBottom).Color = RGB(iRedDark, iGreenDark, iBlueDark) End Sub '// 色の調整 Function AdjustColor(a_iColor As Integer, a_iAdd As Integer) Dim iColor As Long '// 色 '// 基準色に調整値を加えた色を取得 iColor = a_iColor + a_iAdd '// 最大値を超えている場合 If iColor > 256 Then '// 最大値の256として設定する iColor = 256 '// 最小値未満の場合 ElseIf iColor < 0 Then '// 最小値の0として設定する iColor = 0 End If AdjustColor = iColor End Function |
使い方
枠線を付けたいセル範囲を選択します。
選択後にSet3DLine()関数を実行します。実行した状態では選択されたままですのでわかりにくいですが、選択範囲を外すと以下のように枠線が設定され立体化されます。
