Sub kouten_Sen(xs, ys, xe, ye, Cx, Cy, R, Ip_x1, Ip_y1, Ip_x2, Ip_y2)

'=====================
'2点(xs,ys)、(xe,ye)を通る直線　Aと　中心(Cx,Cy）で半径Rの円Bとの交点
'(Ip_x1,Ip_y1) と(Ip_x2,Ip_y2)の2点を求めます。
'=====================
 
Dim A As Single, b As Single, c As Single, k As Single
Dim l As Single
Dim ex As Single, ey As Single
Dim vx As Single, vy As Single
Dim xp As Single, xy As Single

 Gx = Cx
 Gy = Cy - R

A = ye - ys
b = xs - xe
c = -(A * xs + b * ys)

l = Sqr((xe - xs) ^ 2 + (ye - ys) ^ 2)
ex = (xe - xs) / l
ey = (ye - ys) / l
vx = -ey
vy = ex

k = -(A * Cx + b * Cy + c) / (A * vx + b * vy)

xp = Cx + k * vx
yp = Cy + k * vy

s = Sqr(R ^ 2 - k ^ 2)

If s < 0 Then
 End
Else
 Ip_x1 = xp + s * ex
 Ip_y1 = yp + s * ey
 Ip_x2 = xp - s * ex
 Ip_y2 = yp - s * ey
End If

'===================================
'===== グラフ上に交点　をプロットします。
 ActiveSheet.Shapes.AddShape(msoShapeOval, Ip_x1, Ip_y1, Dot, Dot).Select
 ActiveSheet.Shapes.AddShape(msoShapeOval, Ip_x2, Ip_y2, Dot, Dot).Select

End Sub