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