Excel2007の株価チャートに水平線を引く方法

質問

ご質問させていただきます。
Excel2007で１５分足の株価チャートを表示させています。VBAでリアルタイムデータを１５分毎に記録してチャートを表示しています。このチャートに最初から水平線を何本か表示させておきたいのです。
水平線の価格は事前に計算した固定値で、リアルタイムデータとは無関係ですが、毎日変更します。
もう少し具体的に言いますと、毎日午前９時からリアルタイムデータの記録を開始するのですが、水平線の値は９時前に計算できており、日中に変更することはないため、最初からチャートに表示させておきたいのです。
どなたか教えていただけないでしょうか？
なお、当方はExcelやVBAに関しては初歩的な知識しかありません。
よろしくお願いいたします。

回答No.2

end-u · ベストアンサー

別案として、系列を追加する方法ですが、
"Sheet1"が該当シート、
Chartのデータ範囲がA2:E100 だとします。
F2:F100セル、G2:G100セルを作業エリアとして、上限値と下限値をセットします。
（例えばF2セルに上限値を入力するならF3セル以降 =F2 などの式）

Sub test()
　　With Sheets("Sheet1").ChartObjects(1).Chart
　　　　With .SeriesCollection.NewSeries
　　　　　　.AxisGroup = 2
　　　　　　.Values = Sheets("Sheet1").Range("F2:F100")
　　　　　　.Border.Color = vbRed
　　　　End With
　　　　With .SeriesCollection.NewSeries
　　　　　　.AxisGroup = 2
　　　　　　.Values = Sheets("Sheet1").Range("G2:G100")
　　　　　　.Border.Color = vbRed
　　　　End With
　　End With
End Sub
追加した系列の数値を第２軸にしますので、既に第２軸を使っているチャートには使えません。

また、更新されたデータによってy軸の最大値|最小値が変動するような場合は
数値軸を合わせるために、やはりVBA更新時に以下のコードを Call しなければいけません。

Sub try2()
　　Dim c As Chart

　　Set c = Sheets("Sheet1").ChartObjects(1).Chart
　　With c.Axes(xlValue, xlSecondary)
　　　　.MaximumScale = c.Axes(xlValue, xlPrimary).MaximumScale
　　　　.MinimumScale = c.Axes(xlValue, xlPrimary).MinimumScale
　　End With
　　Set c = Nothing
End Sub

お礼

end-u 様

ご回答ありがとうございます。
やりたいことができました！
ご親切に別案まで教えていただき感謝いたします。
この度は本当にありがとうございました。

回答No.1

end-u

チャートに系列を追加し、セルを参照させて表示を自動更新にした方が良いのだとは思いますが、
現状のチャート種類によっては、ちょっと面倒な作業になりそうです。

>VBAでリアルタイムデータを１５分毎に記録してチャートを表示しています。
どうせVBAで処理されるのですから、１つの案として
まずLineShapeを追加しておいて、VBAでデータ更新する時にLineShapeの表示位置を調整する..
という方法が考えられます。

Sub ラインの追加() '１回だけで良い
　　On Error GoTo errH
　　'ActiveSheetの１つ目のChart
　　'またはChartをアクティブにして実行するなら
　　'With ActiveChart 'に変えても良い
　　With ActiveSheet.ChartObjects(1).Chart
　　　　With .Shapes.AddLine(0, 0, 100, 0)
　　　　　　.Name = "上限"
　　　　　　.Line.ForeColor.RGB = RGB(255, 0, 0)
　　　　End With
　　　　With .Shapes.AddLine(0, 0, 100, 0)
　　　　　　.Name = "下限"
　　　　　　.Line.ForeColor.RGB = RGB(255, 0, 0)
　　　　End With
　　End With
errH:
　　If Err.Number <> 0 Then MsgBox Err.Number & "::" & Err.Description
End Sub

上記コードでLineを２本追加します。
後は、VBA更新時に以下のコードを Call すれば良いです。

Sub try()
　　Dim T　As Single 'y軸のTop位置
　　Dim H　As Single 'y軸のHeight
　　Dim L　As Single 'x軸のLeft位置
　　Dim W　As Single 'x軸のWidth
　　Dim mx As Single 'y軸最大値
　　Dim mn As Single 'y軸最小値
　　Dim gp As Single '上限と下限の差
　　Dim up　　　　　 '上限
　　Dim dn　　　　　 '下限

　　On Error GoTo errH
　　With Sheets("Sheet1")
　　　　up = .Range("X1").Value
　　　　dn = .Range("X2").Value
　　　　With .ChartObjects(1).Chart
　　　　　　With .Axes(xlValue)
　　　　　　　　T = .Top
　　　　　　　　H = .Height
　　　　　　　　mx = .MaximumScale
　　　　　　　　mn = .MinimumScale
　　　　　　End With
　　　　　　With .Axes(xlCategory)
　　　　　　　　L = .Left
　　　　　　　　W = .Width
　　　　　　End With
　　　　　　gp = mx - mn
　　　　　　With .Shapes("上限")
　　　　　　　　.Top = (mx - up) * H / gp + T
　　　　　　　　.Left = L
　　　　　　　　.Width = W
　　　　　　End With
　　　　　　With .Shapes("下限")
　　　　　　　　.Top = (mx - dn) * H / gp + T
　　　　　　　　.Left = L
　　　　　　　　.Width = W
　　　　　　End With
　　　　End With
　　End With
errH:
　　If Err.Number <> 0 Then MsgBox Err.Number & "::" & Err.Description
End Sub

>With Sheets("Sheet1")　　　 'シート名
>　　up = .Range("X1").Value '上限を記録しておくセル
>　　dn = .Range("X2").Value '下限を記録しておくセル
この箇所は実際の環境に合わせて適宜変更してください。