Sub DrawCircleFromThreePoints()
Dim x1, x2, x3, y1, y2, y3 As Double
Dim a, b, c, d, e, f As Double
Dim xCenter, yCenter, radius As Double
Dim s, t As Double
Dim Msg As String
'3つの点を取得
x1 = InputBox("最初の点のx座標を入力してください")
y1 = InputBox("最初の点のy座標を入力してください")
x2 = InputBox("2番目の点のx座標を入力してください")
y2 = InputBox("2番目の点のy座標を入力してください")
x3 = InputBox("3番目の点のx座標を入力してください")
y3 = InputBox("3番目の点のy座標を入力してください")
'円の中心と半径を計算
a = x1 - x2
b = y1 - y2
c = x1 - x3
d = y1 - y3
e = (x1 * x1 - x2 * x2 + y1 * y1 - y2 * y2) / 2
f = (x1 * x1 - x3 * x3 + y1 * y1 - y3 * y3) / 2
s = (d * e - b * f) / (a * d - b * c)
t = (a * f - c * e) / (a * d - b * c)
xCenter = s
yCenter = t
radius = Sqr((x1 - xCenter) ^ 2 + (y1 - yCenter) ^ 2)
'結果を表示
Msg = "中心座標: (" & xCenter & ", " & yCenter & ")" & vbNewLine
Msg = Msg & "半径: " & radius
MsgBox Msg
'円を描画
With ActiveSheet.Shapes.AddShape(msoShapeOval, xCenter - radius, yCenter - radius, radius * 2, radius * 2)
.Line.Weight = 1
End With
End Sub