【修習VBA】事例カードとかのセルの中にいい感じの円を描く関数

引数にとったセル（結合可）の中にいい感じの円を描くよ
いい感じさは各自調整してな！

Option Explicit

Public Function MakeCircle(r As Range, Optional myWeight As Double = 1.5) As Shape

    Dim W   As Double
    Dim H   As Double
    Dim L As Double
    Dim T As Double
    Dim C   As Shape
    
' 横軸方向にセル結合している場合のセルの高さと幅を調べる
' 縦軸方向は考えてないです
    Dim i
    Dim totalWidth As Double
    totalWidth = 0
    
    With r.MergeArea
        For i = 1 To .Count
            totalWidth = totalWidth + .Item(i).Width
        Next
    End With
    
' 円のサイズ
    H = r.Height * 0.9
    W = totalWidth * 0.8
    
'円の左端、上端の位置
    L = r.Left
    T = r.Top

' 円を描画
    Set C = ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, H)
    
    ' 線の色
    C.Line.ForeColor.RGB = RGB(0, 0, 0)
    C.Fill.Visible = False
    
    ' 線の太さ
    C.Line.Weight = myWeight
    
    ' 縦横中央揃え
    C.Left = r.Left + ((totalWidth - W) / 2)
    C.Top = T + ((r.Height - H) / 2)
    
    Set MakeCircle = C
  
End Function