別案として、系列を追加する方法ですが、
"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
追加した系列の数値を第2軸にしますので、既に第2軸を使っているチャートには使えません。
また、更新されたデータによって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
チャートに系列を追加し、セルを参照させて表示を自動更新にした方が良いのだとは思いますが、
現状のチャート種類によっては、ちょっと面倒な作業になりそうです。
>VBAでリアルタイムデータを15分毎に記録してチャートを表示しています。
どうせVBAで処理されるのですから、1つの案として
まずLineShapeを追加しておいて、VBAでデータ更新する時にLineShapeの表示位置を調整する..
という方法が考えられます。
Sub ラインの追加() '1回だけで良い
On Error GoTo errH
'ActiveSheetの1つ目の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を2本追加します。
後は、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 '下限を記録しておくセル
この箇所は実際の環境に合わせて適宜変更してください。
お礼
end-u 様 ご回答ありがとうございます。 やりたいことができました! ご親切に別案まで教えていただき感謝いたします。 この度は本当にありがとうございました。