■Chart.Shapes.AddLine

Excel2007の株価チャートに水平線を引く方法 - 教えて！goo
#もしかしてChartに線ひくのが流行り？
前回記事の別解..というか蛇足。

Option Explicit

Sub 準備() 'Sheet追加しダミーデータセット、Chart作成
　　Dim ws As Worksheet

　　Set ws = Sheets.Add
　　ws.Range("A1:D1").Value = Array("日付", "数値", "タテ軸", "ヨコ軸")
　　ws.Range("A2:D2").Value = Array(#1/1/2011#, "=INT(RAND()*100)", #1/15/2011#, 55)
　　With ws.Range("A2:B22")
　　　　.Range("A1:B1").AutoFill Destination:=.Cells, Type:=xlFillDefault
　　　　.Columns(1).NumberFormat = "m/d"
　　　　.Range("C1").NumberFormat = "m/d"
　　　　.Columns(2).Value = .Columns(2).Value
　　End With
　　With ws.ChartObjects.Add(ws.Range("D4").Left, ws.Range("D4").Top, 300, 200).Chart
　　　　.ChartType = xlLine
　　　　.HasLegend = False
　　　　.SetSourceData Source:=ws.Range("A2:B22"), PlotBy:=xlColumns
　　End With
　　Set ws = Nothing
　　Call try
End Sub
'-------------------------------------------------
Sub try()
　　With ActiveSheet.ChartObjects(1).Chart
　　　　With .Shapes.AddLine(0, 0, 0, 0)
　　　　　　.Name = "タテ"
　　　　　　.Line.ForeColor.RGB = RGB(0, 255, 0)
　　　　　　.Line.DashStyle = msoLineDash
　　　　End With
　　　　With .Shapes.AddLine(0, 0, 0, 0)
　　　　　　.Name = "ヨコ"
　　　　　　.Line.ForeColor.RGB = RGB(255, 0, 0)
　　　　　　.Line.DashStyle = msoLineDash
　　　　End With
　　End With
　　Call stry
End Sub
'-------------------------------------------------
Sub stry()
　　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 mxy As Single 'y軸最大値
　　Dim gpy As Single 'y最大値と最小値の差
　　Dim mnx As Single 'x軸最小値
　　Dim gpx As Single 'x最大値と最小値の差
　　Dim x
　　Dim y

　　On Error GoTo errHndlr
　　With ActiveSheet
　　　　x = .Range("C2").Value
　　　　y = .Range("D2").Value
　　　　With .ChartObjects(1).Chart
　　　　　　With .Axes(xlValue)
　　　　　　　　T = .Top
　　　　　　　　H = .Height
　　　　　　　　mxy = .MaximumScale
　　　　　　　　gpy = mxy - .MinimumScale
　　　　　　End With
　　　　　　With .Axes(xlCategory)
　　　　　　　　L = .Left
　　　　　　　　W = .Width
　　　　　　　　mnx = .MinimumScale
　　　　　　　　gpx = .MaximumScale - mnx
　　　　　　End With
　　　　　　With .Shapes("タテ")
　　　　　　　　.Left = (x - mnx) * W / gpx + L
　　　　　　　　.Top = T
　　　　　　　　.Height = H
　　　　　　End With
　　　　　　With .Shapes("ヨコ")
　　　　　　　　.Top = (mxy - y) * H / gpy + T
　　　　　　　　.Left = L
　　　　　　　　.Width = W
　　　　　　End With
　　　　End With
　　End With
errHndlr:
　　If Err.Number <> 0 Then MsgBox Err.Number & "::" & Err.Description
End Sub



#LineShapeなのでセルと連動してない。シート側にイベントプロシージャが必要。