セルの中心に円を描画
Excel では、セルの真ん中に円を描きたくなることがたまにあります。
どうせ描くなら、きれいに描きたい。
ということで、セルの中心に円を描画するユーザー定義関数を作成して
みました。
Public Function MakeCircle(r As Range, Optional ρ As Double = 0.85, _ Optional myWeight As Double = 1.5) As Shape Dim T As Double Dim L As Double Dim W As Double Dim H As Double Dim C As Shape ' 円の直径決定。セルの縦横を比較して、短い方を基準とする。 If r.Width >= r.Height Then W = r.Height * ρ Else W = r.Width * ρ End If ' 円のサイズと配置位置を決定。 H = W T = r.Top + (r.Height - H) / 2 L = r.Left + (r.Width - W) / 2 ' 円を描画。 Set C = ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, H) C.Line.ForeColor.ObjectThemeColor = msoThemeColorText1 C.Line.Weight = myWeight Set MakeCircle = C End Function
イメージとしては、こんな感じです。指定したセルの真ん中に、少し小さめに円を描画しています。
Optional ρ As Double = 0.85 は、円の「少し小さめ度合い」に関する引数です。何も指定しなければ、セルの縦横サイズのうち短い方の、85%のサイズで円を描画します。
Optional myWeight As Double = 1.5 は、円の線の太さです。何も指定しなければ、1.5 になります。お好みに合わせて調整ください。
ユーザー定義関数なので、作成した円を変数にセットすることもできます。
Sub test() Dim myCircle As Shape Set myCircle = MakeCircle(Selection) End Sub
円の塗り潰しなどを変更するなど、引き続き処理したい場合などに有効です。
参考まで。