| |
Sheet1のA〜E列をプロット範囲にした、株価ローソク足・終値移動平均2本のグラフ
を作り、そこへ新しい系列としてF列を棒グラフで追加するとします。
最初に出てくるフォームに、グラフタイトルを入力して下さい。
Sub MyChart_StockData()
Dim ChTxt As String
Dim MyR As Range
Dim MinV As Long, Bet As Long
Dim Ns As Series
ChTxt = InputBox("グラフタイトルを入力して下さい")
If ChTxt = "" Then Exit Sub
Set MyR = Sheets("Sheet1").Range("A1").CurrentRegion
Application.ScreenUpdating = False
Charts.Add
With ActiveChart
.SetSourceData Source:= _
Range(MyR.Columns(1), MyR.Columns(5)), _
PlotBy:=xlColumns
.ChartType = xlStockOHLC
.Location Where:=xlLocationAsNewSheet
.HasLegend = False
With .ChartGroups(1)
.HasUpDownBars = True
.DownBars.Interior.ColorIndex = 5
.DownBars.Border.ColorIndex = 5
.UpBars.Interior.ColorIndex = 6
.UpBars.Border.ColorIndex = 6
End With
.Axes(xlCategory).CategoryType = xlCategoryScale
MinV = Int(WorksheetFunction.Min(.SeriesCollection(3).Values))
With .Axes(xlValue)
Bet = Int(.MajorUnit)
.MinimumScale = WorksheetFunction.Floor(MinV, Bet)
End With
If MyR.Columns.Count = 6 Then
Set Ns = .SeriesCollection.NewSeries
With Ns
.XValues = MyR.Columns(1)
.Values = MyR.Columns(6)
.AxisGroup = 2
.ChartType = xlColumnClustered
.Interior.ColorIndex = 39
.Border.ColorIndex = 39
End With
With .Axes(xlValue, xlSecondary)
.MaximumScale = 100
.MinimumScale = 0
End With
End If
With .SeriesCollection(4).Trendlines _
.Add(Type:=xlMovingAvg, Period:=13).Border
.ColorIndex = 10
.Weight = xlHairline
End With
With .SeriesCollection(4).Trendlines _
.Add(Type:=xlMovingAvg, Period:=25).Border
.ColorIndex = 3
.Weight = xlHairline
End With
.SizeWithWindow = True
.HasTitle = True
.ChartTitle.Font.Size = 11
.ChartTitle.Characters.Text = ChTxt
.Name = ChTxt
.Deselect
End With
Application.ScreenUpdating = True
End Sub
|
|
