セルの中心に円を描画

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

イメージとしては、こんな感じです。指定したセルの真ん中に、少し小さめに円を描画しています。

f:id:Infoment:20180701214950p:plain

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

円の塗り潰しなどを変更するなど、引き続き処理したい場合などに有効です。

参考まで。