Shareholder-stock price curve and shareholder-Stock Price Curve
Sub shareholder and share price relative curve () Dim obj As AcadObject For Each obj In ThisDrawing. modelSpace obj. delete Next ThisDrawing. application. update Dim a () As Double, p () As Double f = "002106" On Error Resume Next Set oDoc = CreateObject ("htmlfile") Set ww = CreateObject ("WinHttp. winHttpRequest.5.1 ") With CreateObject (" Microsoft. XMLHTTP "). open "GET", "http://stock.finance.qq.com/corp1/stk_holder_count.php? Zqdm = "& f, False. send oDoc. body. innerHTML =. responsetext Set r = oDoc. all. tags ("table") (1 ). rows ReDim a (0 To 3 * r. length-7), p (0 To 3 * r. length-7) c = 10000000.00011 d = 0.0000035 s = 10000 t = 0.0000000035 For I = 1 To r. length-2 a (I-1) * 3) = r. length-I p (I-1) * 3) = r. length-I a (I-1) * 3 + 1) = r (I ). cells (2 ). innerText/r (I ). cells (3 ). innerText If c> a (I-1) * 3 + 1) Th En c = a (I-1) * 3 + 1) g = r. length-I End If d <a (I-1) * 3 + 1) Then d = a (I-1) * 3 + 1) a (I-1) * 3 + 2) = 0 p (I-1) * 3 + 2) = 0 h = r (I ). cells (0 ). innerText1: ww. open "GET", "http://q.stock.sohu.com/hisHq? Code = cn _ "& f &" & start = "& Format (h," yyyymmdd ") &" & end = "& Format (h," yyyymmdd ") & "& stat = 1 & order = D & period = d & callback = a & rt = jsonp", False ww. send p (I-1) * 3 + 1) = Split (ww. responsetext, "", ") (2) If p (I-1) * 3 + 1) <0.01 Then h = DateAdd (" d ",-1, h) GoTo 1 End If I <20 And s> p (I-1) * 3 + 1) Then s = p (I-1) * 3 + 1) t = r. length-I End If 'debug. print h, p (I-1) * 3 + 1) Next I For I = 1 To r. length-1 a (I-1) * 3 + 1) = a (I-1) * 3 + 1)/c p (I-1) * 3 + 1) = p (I-1) * 3 + 1)/s Next I End With Dim splineobj As AcadSpline Dim starttan (0 To 2) as Double Dim endtan (0 To 2) As Double Dim point1 (0 To 2) As Double Dim point2 (0 To 2) As Double Dim fitpoints (0 To 8) as Double starttan (0) = 0: starttan (1) = 0: starttan (2) = 0 endtan (0) = 0: endtan (1) = 0: endtan (2) = 0 point1 (0) = g: point1 (1) = 1: point1 (2) = 0 point2 (0) = r. length: point2 (1) = d/s: point2 (2) = 0 Set splineobj = ThisDrawing. modelSpace. addSpline (a, starttan, endtan) splineobj. color = acRed Set Annotation = ThisDrawing. modelSpace. addMText (point1, 20, Format (c, "0.000") Annotation. height = 1 point1 (0) = t: point1 (1) = 2: point1 (2) = 0 Set splineobj = ThisDrawing. modelSpace. addSpline (p, starttan, endtan) Set Annotation = ThisDrawing. modelSpace. addMText (point1, 20, s) Annotation. height = 1 ThisDrawing. application. zoomWindow starttan, point2 ThisDrawing. application. updateEnd Sub