[[20070314185433]]　『ひとつのセルに2色の色をつける』（なな）　ページの最後に飛ぶ

『ひとつのセルに2色の色をつける』（なな）

 ひとつのセルにセルの書式設定で罫線を斜めに入れた時に
 半分ずつ色を塗る事は出来ますか？
 わかりにくい文章でごめんまさいm(__)m

 昔このような回答をした方がいました。↓　　(#REF!MAN)
[[20040607182432]]『セルの斜め半分塗りつぶし』（YUTOMAMA）

 外字で作成　フォント色設定（条件書式等併用可）
（外字）

 色を塗るには、その色が入れられる『形』が必要になります
 斜線を入れても、セルが二つに分かれるわけではないので
 塗ることはできないと思います

 ただ、オートシェイプ等を利用して、『塗られている』様に
 見せかける事は可能だと思います

 私がやるとしたら、オートシェイプの『直角三角形』を使用
 ALTを押しながら作成すると、セルに吸着します
 二つの『直角三角形』上に文字を入れるなら、
 テキストボックスを塗り無しで重ねるか、塗りを『透明』で設定
 一つずつなら『テキストの追加』から入力
 周りの罫線無しで斜線のみにしたいなら、『直角三角形』の線無しで
 斜線をオートシェイプの『直線』で描画

 (Ohagi)

 マクロで作ってみました。
 希望のセルを選択してマクロ実行で2色に綺麗に分割着色します。
 左下が三角で，色混在ですので少し色が汚くなりますが
 我慢です。  反対側斜線は難しいです。
 オートシェイプの『直角三角形』の配置がそうなっているからです。

  好きな色，透明度にコードの数値を調整ください。

 進展して，選択範囲全体を着色できるようにも，次に挑戦してみます。

 （夕焼）

 Sub セル斜線分割2色着色()
 hi = 1#  ' 楕円高さのセル高さ倍率1.5位,適宜変更可能
 awide = ActiveCell.Width
 aheight = ActiveCell.Height
 aleft = ActiveCell.Left
 atop = ActiveCell.Top
 ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, aleft, atop, awide, aheight * hi).Select

    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 7 '左下の色設定番号（混色）
    Selection.ShapeRange.Fill.Transparency = 0.73        '左下の色透明度

    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse

 ActiveSheet.Shapes.AddShape(msoShapeRectangle, aleft, atop, awide, aheight * hi).Select

 Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 '右上の色設定番号
    Selection.ShapeRange.Fill.Transparency = 0.9     '右上の色透明度
 Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
 Range("I12").Select

 End Sub

 指定範囲全体に対して処理できます。
 範囲を選択（ドラッグして，反転色状態）して，マクロを実行ください。
 ちなみに，下のマクロは，一括で色を解除します。
  （夕焼）

 Sub 範囲セル斜線分割2色着色()

    For Each c In Selection

 hi = 1#  ' 楕円高さのセル高さ倍率1.5位,適宜変更可能
 awide = c.Width
 aheight = c.Height
 aleft = c.Left
 atop = c.Top

 ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, aleft, atop, awide, aheight * hi).Select

    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 7 '左下の色設定番号（混色）
    Selection.ShapeRange.Fill.Transparency = 0.73        '左下の色透明度

    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse

 ActiveSheet.Shapes.AddShape(msoShapeRectangle, aleft, atop, awide, aheight * hi).Select

 Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 '右上の色設定番号
    Selection.ShapeRange.Fill.Transparency = 0.9     '右上の色透明度
 Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
 Range("I12").Select

  Next

 End Sub

   ------------

 Sub 全セル2色着色解除()

 an = ActiveSheet.Shapes.Count

 For i = an To 1 Step -1

 ActiveSheet.Shapes(i).Delete

 Next

 End Sub

 上の方法ではセルに2色付きますが，セルをクリックすると
オートシェイプが選択されて，データを素直に打ち込めない
ですね。（夕焼）

コメント返信：

[ 一覧(最新更新順) ]

[[20070314185433]] 『ひとつのセルに2色の色をつける』（なな） ページの最後に飛ぶ

[[20070314185433]]　『ひとつのセルに2色の色をつける』（なな）　ページの最後に飛ぶ