Sub Kouten_En(x1, y1, R_1, x2, y2, R_2, xp1, yp1, xp2, yp2)
'=========================
' 中心座標(x1,y1) 半径R_1 の円Aと
' 中心座標(x2,y2) 半径R_2 の円Bの交点
' (xp1, yp1) と( xp2, yp2)を求めます。
'=========================
Dim R1 As Double, R2 As Double, l As Double
Dim cc As Double
Dim Alpha As Double
Dim theta As Double
Dim mode as integer '円 および 交点を描画する場合は”1”
mode = 0
'=============== 円の半径
R1 = R_1
R2 = R_2
'=============== 円の中心座標
xc1 = x1
yc1 = y1
xc2 = x2
yc2 = y2
l = Sqr((xc2 - xc1) ^ 2 + (yc2 - yc1) ^ 2)
theta = Atan2XLSversion((xc2 - xc1), (yc2 - yc1))
cc = (l ^ 2 + R1 ^ 2 - R2 ^ 2) / (2 * l * R1)
Alpha = Arccos(cc)
xp1 = xc1 + R1 * Cos(theta + Alpha)
yp1 = yc1 + R1 * Sin(theta + Alpha)
xp2 = xc1 + R1 * Cos(theta - Alpha)
yp2 = yc1 + R1 * Sin(theta - Alpha)
If mode = 1 Then
ActiveSheet.Shapes.AddLine(xp1, yp1, xp2, yp2).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 22
Selection.ShapeRange.Line.DashStyle = msoLineDash
Selection.ShapeRange.Line.Weight = wgt_aux
ActiveSheet.Shapes.AddShape(msoShapeArc, xc1, yc1 - R1, R1, R1).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 22
Selection.ShapeRange.Line.DashStyle = msoLineDash
Selection.ShapeRange.Line.Weight = wgt
Selection.ShapeRange.Adjustments.Item(1) = 0 'Start deg
Selection.ShapeRange.Adjustments.Item(2) = 0 'End deg 右回り
Selection.ShapeRange.Line.Weight = wgt_aux
ActiveSheet.Shapes.AddShape(msoShapeArc, xc2, yc2 - R2, R2, R2).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 22
Selection.ShapeRange.Line.DashStyle = msoLineDash
Selection.ShapeRange.Adjustments.Item(1) = 0 'Start deg
Selection.ShapeRange.Adjustments.Item(2) = 0 'End deg 右回り
Selection.ShapeRange.Line.Weight = wgt_aux
ActiveSheet.Shapes.AddShape(msoShapeOval, xp1, yp1, Dot, Dot).Select
ActiveSheet.Shapes.AddShape(msoShapeOval, xp2, yp2, Dot, Dot).Select
End If
End Sub