麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 有關excelVBA圖表的問題 [打印本頁]

作者: lin_6219 時間: 2013-6-7 22:46 標題: 有關excelVBA圖表的問題

各位各位~
不好意思，我現在再寫VBA圖表，要做股市K線圖，
要在一張圖表上放上K棒和移動平均線，並合併圖表放上成交量，
但目前這樣的程式在2003的版本，顯示出來很正常，
可是當用2007時，由於副作標是以成交量為主，
然後移動平均線也以副作標為主，
會導致移動平均線被擠在底下看不見= =
有沒有辦法，讓移動平均線也放在主座標軸
不會受到成交量影響，
拜託各位幫我想想，真的很急~麻煩了謝謝:'(

作者: lin_6219 時間: 2013-6-7 23:04

有需要程式碼我可以附上謝謝

))

作者: c_c_lai 時間: 2013-6-8 09:27

回復 2# lin_6219
未附上檔案，各位大大如何測試你所謂的問題。

作者: lin_6219 時間: 2013-6-8 12:43

回復 3# c_c_lai
抱歉抱歉~我是新手也第一次發問
這裡附上檔案
請大家幫幫我，謝謝:))

作者: c_c_lai 時間: 2013-6-8 19:41

回復 4# lin_6219
試試看！

Sub KChartWithVolume() ' K 線圖與成交量圖放在同一圖表
Dim nRow As Integer, ChtObj As ChartObject
Dim i As Integer, j As Integer
Dim myMax, myMin, GapNr As Integer
On Error Resume Next
Worksheets("主畫面").ChartObjects.Delete
nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
With Worksheets("繪圖資料") ' 設定主座標軸最大及最小值
myMax = Application.Max(.Range("C2:C" & CStr(nRow)))
myMin = Application.Min(.Range("D2:D" & CStr(nRow)))
myMin = myMin - (myMax - myMin)
End With
' Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 490, 280)
With ChtObj.Chart
' .SetSourceData Worksheets("繪圖資料").Range("A2:E" & CStr(nRow))
.SetSourceData Source:=Range("繪圖資料!$A$2:繪圖資料!$E$" & CStr(nRow))
.ChartType = xlStockOHLC
.HasTitle = True
.ChartTitle.Characters.Text = "K線與成交量圖"
With .ChartGroups(1)
.HasUpDownBars = True
.UpBars.Interior.ColorIndex = 3
.DownBars.Interior.ColorIndex = 1
.GapWidth = 10
End With
.SeriesCollection(1).Name = "" ' 開盤價
.SeriesCollection(2).Name = "" ' 最高價
.SeriesCollection(3).Name = "" ' 最低價
.SeriesCollection(4).Name = "" ' 收盤價 (成交價)
With .Axes(xlValue)
.MaximumScale = Round(myMax, 2)
.MinimumScale = Round(myMin, 2)
' .MaximumScale = myMax
' .MinimumScale = myMin
.MajorUnit = 0.5 ' 圖表左側數列之間距值設定
End With
' .SeriesCollection.Add Worksheets("繪圖資料").Range("G1:G" & CStr(nRow))
.SeriesCollection.Add Source:=Range("繪圖資料!$G$1:繪圖資料!$G$" & CStr(nRow))
With .SeriesCollection(5)
.AxisGroup = 1
' .ChartType = xlXYScatterLinesNoMarkers
.ChartType = xlLines
.Name = "=繪圖資料!$G$1" ' 移動平均線
.Border.ColorIndex = 7
End With
' .SeriesCollection.NewSeries ' 新增成交量數列
.SeriesCollection.Add Source:=Range("繪圖資料!$F$1:繪圖資料!$F$" & CStr(nRow))
With .SeriesCollection(6)
.AxisGroup = 2 ' 設為副座標軸
' .Values = Worksheets("繪圖資料").Range("F2:F" & CStr(nRow))
.ChartType = xlColumnClustered
.Name = "成交量"
.Interior.ColorIndex = 17
End With
With Worksheets("繪圖資料") ' 計算副座標軸最大及最小值
myMax = Application.Max(.Range("F2:F" & CStr(nRow)))
myMax = myMax * 2
myMin = 0.01
End With
With .Axes(xlValue, xlSecondary) ' 設定副座標軸最大及最小值
.MaximumScale = Round(myMax, 0)
.MinimumScale = Round(myMin, 0)
End With
With .PlotArea ' 調整繪圖區域大小與位置
.Top = .Top - 2
.Height = .Height + 10
.Width = .Width + 75
End With
.PlotArea.Select ' 將圖表的繪圖區格線灰黑顏色修改成淡青色、以及表格實線改以虛線表示
.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.8000000119
.Transparency = 0
.Weight = 0.25
.DashStyle = msoLineSysDash
End With
With .Legend
.Position = xlLegendPositionTop
.Top = .Top - 8
.Border.ColorIndex = 57
.Border.Weight = xlThin
.Border.LineStyle = xlContinuous
.Interior.ColorIndex = xlNone
End With
End With
Worksheets("主畫面").[A1].Select
End Sub

複製代碼

作者: c_c_lai 時間: 2013-6-8 19:44

回復 4# lin_6219
附上圖表共參考。
[attach]15204[/attach]

作者: c_c_lai 時間: 2013-6-8 21:23

回復 4# lin_6219
股票柱狀圖好像與其它圖表無法共處在同一主軸上。

作者: lin_6219 時間: 2013-6-9 01:27

回復 7# c_c_lai
好喔，非常非常感謝你:)))))
目前好像真的不能把K線和移動平均線還有成交量一起放在同一張圖上，
學校的老師也找不到解決的辦法，
再次感謝你的幫忙，謝謝你。:)

作者: c_c_lai 時間: 2013-6-9 06:58

回復 8# lin_6219
一般我是將成交量(副座標軸)與股票柱狀圖(主座標軸)分開處哩，
亦即主座標軸指存在股票柱狀圖，其他均歸副座標軸歸類。
如圖：
[attach]15205[/attach]
[attach]15206[/attach]
[attach]15207[/attach]

作者: c_c_lai 時間: 2013-6-9 07:38

回復 8# lin_6219
我將你提供的程式碼稍稍修改了一些，
簡潔了一些使用之語法，效益性亦會改良。
如圖： (上圖是原本程式的執行結果，下圖是經過修飾的)
[attach]15208[/attach]

Sub KChartWithVolume3() ' K線圖與成交量圖放在同一圖表
Dim nRow As Integer, ChtObj As ChartObject
Dim i As Integer, j As Integer
Dim myMax, myMin, GapNr As Integer
On Error Resume Next
Worksheets("主畫面").ChartObjects.Delete
nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
With ChtObj.Chart
.SetSourceData Worksheets("繪圖資料").Range("B2:E" & CStr(nRow))
.ChartType = xlStockOHLC
.HasTitle = True
.ChartTitle.Characters.Text = "K線與成交量圖"
.SeriesCollection.Add Worksheets("繪圖資料").Range("G1:G" & CStr(nRow))
With .SeriesCollection(5)
.ChartType = xlXYScatterLinesNoMarkers
' .ChartType = xlLine
.Border.ColorIndex = 7
.AxisGroup = xlPrimary
.Name = "=繪圖資料!$G$1"
End With
With .ChartGroups(1)
.AxisGroup = xlPrimary
.HasUpDownBars = True
.UpBars.Interior.ColorIndex = 3
.DownBars.Interior.ColorIndex = 1
.GapWidth = 10
End With
With Worksheets("繪圖資料") ' 設定主座標軸最大及最小值
myMax = Application.Max(.Range("C2:C" & CStr(nRow)))
myMin = Application.Min(.Range("D2:D" & CStr(nRow)))
myMin = myMin - (myMax - myMin)
End With
With .Axes(xlValue)
.MaximumScale = Round(myMax, 2)
.MinimumScale = Round(myMin, 2)
End With
.SeriesCollection.NewSeries ' 新增成交量數列
With .SeriesCollection(6)
.Values = Worksheets("繪圖資料").Range("F2:F" & CStr(nRow))
.ChartType = xlColumnClustered
.Name = "成交量"
.Interior.ColorIndex = 17
.AxisGroup = xlSecondary ' 設為副座標軸
End With
With Worksheets("繪圖資料") ' 計算副座標軸最大及最小值
myMax = Application.Max(.Range("F2:F" & CStr(nRow)))
myMax = myMax * 2
myMin = 0.01
End With
With .Axes(xlValue, xlSecondary) ' 設定副座標軸最大及最小值
.MaximumScale = Round(myMax, 0)
.MinimumScale = Round(myMin, 0)
End With
With .Axes(xlCategory) ' X座標軸 (時間軸)
.CategoryType = xlCategoryScale
.TickLabelSpacing = 3 ' 標示間距
.TickLabels.NumberFormatLocal = "yyyy/m/d"
.TickLabels.Font.ColorIndex = 5 ' Blue Color
End With
With .Legend ' 刪除不必要的圖例
.LegendEntries(2).Delete
.LegendEntries(2).Delete
.LegendEntries(2).Delete
.LegendEntries(2).Delete
.Top = .Parent.ChartTitle.Top - 5
End With
With .PlotArea ' 調整繪圖區域大小與位置
.Top = .Top - 10
.Height = .Height + 10
.Width = .Width + 75
End With
.PlotArea.Select ' 將圖表的繪圖區格線灰黑顏色修改成淡青色、以及表格實線改以虛線表示
.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.8000000119
.Transparency = 0
.Weight = 0.25
.DashStyle = msoLineSysDash
End With
End With
Worksheets("主畫面").[A1].Select
End Sub

複製代碼

作者: lin_6219 時間: 2013-6-9 14:39

回復 10# c_c_lai
好的，十分感謝你喔，我會在做修改的，讓效益更好。再次謝謝你:)))

作者: lin_6219 時間: 2013-6-9 15:18

回復 10# c_c_lai
不好意思在向你詢問一個問題
我現在如果要畫一個xlline的圖
然後我要把日期加進去當成最底下的座標
通常就把日期欄位一起放進資料來源
可是他居然也畫出線來
這有辦法可以解決嗎
謝謝

作者: c_c_lai 時間: 2013-6-9 15:24

回復 c_c_lai
不好意思在向你詢問一個問題
我現在如果要畫一個xlline的圖
然後我要把日期加進去當成最 ...
lin_6219 發表於 2013-6-9 15:18

你是一開始便宣告的嗎？譬如下方之例子：
.SetSourceData Worksheets("繪圖資料").Range("A2:E" & CStr(nRow))
還是在中段加入的？

作者: lin_6219 時間: 2013-6-9 15:50

回復 13# c_c_lai

我是一開始就加進去了，可是我要畫線的資料在J欄，中間的資料沒要畫線，
所以我這樣打 SetSourceData Worksheets("繪圖資料").Range("A2:A" &Cstr(nrow), "J2:J" & CStr(nRow))

作者: c_c_lai 時間: 2013-6-9 16:17

回復 14# lin_6219
附上測試程式供參考： Range("繪圖資料!$A$2:繪圖資料!$A$" & CStr(nRow) & ", 繪圖資料!$F$2:繪圖資料!$F$" & CStr(nRow))

Sub Test()
Dim nRow As Integer, ChtObj As ChartObject
Dim i As Integer, j As Integer, chartname As String
Dim myMax, myMin, GapNr As Integer
On Error Resume Next
With Worksheets("主畫面")
.ChartObjects.Delete
.Select
nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
With ChtObj.Chart
.SetSourceData Source:=Range("繪圖資料!$A$2:繪圖資料!$A$" & CStr(nRow) & ", 繪圖資料!$F$2:繪圖資料!$F$" & CStr(nRow))
.ChartType = xlXYScatterLinesNoMarkers
.HasTitle = True
.ChartTitle.Characters.Text = "K線與成交量圖"
With .SeriesCollection(1)
.Border.ColorIndex = 7
.Name = "=繪圖資料!$F$1"
End With
With .Axes(xlCategory) ' X座標軸 (時間軸)
.CategoryType = xlCategoryScale
.TickLabelSpacing = 3 ' 標示間距
.TickLabels.NumberFormatLocal = "yyyy/m/d"
.TickLabels.Font.ColorIndex = 5 ' Blue Color
End With
End With
End With
End Sub

複製代碼

[attach]15219[/attach]

作者: lin_6219 時間: 2013-6-10 00:04

回復 15# c_c_lai
非常非常感謝你，我還有一個小小問題，就是目前坐標軸沒問題了，可是日期軸的部分，
他對應的直槓(黑線間隔)，不像你的只有有日期才有出現，而是全部都出現有出現，請問有設定的屬性嗎?

作者: c_c_lai 時間: 2013-6-10 06:39

回復 16# lin_6219
對應的直槓(黑線間隔)，不像你的只有有日期才有出現，而是全部都出現有出現？
不太明白你指的是？能否描述清楚些？

作者: lin_6219 時間: 2013-6-10 22:37

[attach]15230[/attach]回復 17# c_c_lai
不好意思，這麼晚才回你，
我所指的就是圖中黃色框起來的部分，你的圖是有日期的地方，向上才有黑槓，
但我的每個間距都有，是哪邊需要做設定嗎？感謝:))

作者: c_c_lai 時間: 2013-6-11 12:22

回復 18# lin_6219
這我倒是沒去留意，為什麼會不同，
我也不清楚。乾脆附上程式碼讓你核對：

Sub Test()
Dim nRow As Integer, ChtObj As ChartObject
Dim i As Integer, j As Integer, chartname As String
Dim myMax, myMin, GapNr As Integer
On Error Resume Next
With Worksheets("主畫面")
.ChartObjects.Delete
.Select
nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
With ChtObj.Chart
' .SetSourceData Source:=Range("繪圖資料!$A$2:繪圖資料!$A$20, 繪圖資料!$F$2:繪圖資料!$F$20")
.SetSourceData Source:=Range("繪圖資料!$A$2:繪圖資料!$A$" & CStr(nRow) & ", 繪圖資料!$F$2:繪圖資料!$F$" & CStr(nRow))
.ChartType = xlXYScatterLinesNoMarkers
.HasTitle = True
.ChartTitle.Characters.Text = "K線與成交量圖"
With .SeriesCollection(1)
.Border.ColorIndex = 7
.Name = "=繪圖資料!$F$1"
End With
With .Axes(xlCategory) ' X座標軸 (時間軸)
' .CategoryType = xlCategoryScale
' .TickLabelSpacing = 1 ' 標示間距
.TickLabels.NumberFormatLocal = "yyyy/m/d"
.TickLabels.Font.ColorIndex = 5 ' Blue Color
' .TickLabels.Orientation = xlTickLabelOrientationUpward
End With
End With
End With
End Sub

複製代碼

作者: lin_6219 時間: 2013-6-11 15:49

回復 19# c_c_lai
好的，非常感謝你喔，我核對看看然後試試，謝謝你:D

作者: lin_6219 時間: 2013-6-12 01:13

找到了，我是用xlLine劃線，所以才會有每個間距出現，大家可以用 xlXYScatterLinesNoMarkers 試看看。

作者: c_c_lai 時間: 2013-6-12 06:19

本帖最後由 c_c_lai 於 2013-6-12 06:25 編輯

找到了，我是用xlLine劃線，所以才會有每個間距出現，大家可以用 xlXYScatterLinesNoMarkers 試看看。
lin_6219 發表於 2013-6-12 01:13

請看了圖示後，再行觀察。xlXYScatterLinesNoMarkers 並非是主因，
關鍵點應該是 "日期時間軸" 之歸屬，且是位於 xlPrimary 主座標軸。
因為你的日期是用民國年，故在圖表複雜處理下日期顯示亦有不同。
語法內容之增減，結果亦造成會些許之異同。只能在Coding時盡力避開。
如以圖1、圖2 為例，因 "移動平均線" 與 "日期時間軸" 均位於主座標軸；
圖3~6 則是以股票柱狀圖 (xlStockOHLC) 為主座標軸，是故圖1~2 論定便不適用。
至於圖3~4、圖5~6 的顯示日期為何几近雷同的模組會有不同結果那就要
仔細去觀察程式碼了。
[attach]15237[/attach][attach]15236[/attach]
[attach]15238[/attach][attach]15239[/attach]
[attach]15240[/attach][attach]15241[/attach]

作者: c_c_lai 時間: 2013-6-12 06:28

本帖最後由 c_c_lai 於 2013-6-12 06:32 編輯

回復 21# lin_6219
想了想還是將程式模組貼上，你有空時再行觀察。

Sub KChartWithVolume() ' K線圖與成交量圖放在同一圖表
Dim nRow As Integer, ChtObj As ChartObject
Dim i As Integer, j As Integer
Dim myMax, myMin, GapNr As Integer
On Error Resume Next
With Worksheets("主畫面")
.ChartObjects.Delete
nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
Set ChtObj = .ChartObjects.Add(1, 1, 450, 250)
With ChtObj.Chart
.SetSourceData Worksheets("繪圖資料").Range("A1:E" & CStr(nRow))
.ChartType = xlStockOHLC
.HasTitle = True
.ChartTitle.Characters.Text = "K線與成交量圖"
With .ChartGroups(1)
.AxisGroup = xlPrimary
.HasUpDownBars = True
.UpBars.Interior.ColorIndex = 3
.DownBars.Interior.ColorIndex = 1
.GapWidth = 10
End With
.SeriesCollection.Add Worksheets("繪圖資料").Range("G2:G" & CStr(nRow))
With .SeriesCollection(5)
' .ChartType = xlXYScatterLinesNoMarkers
.ChartType = xlLine
.AxisGroup = xlPrimary
.Border.ColorIndex = 7
.Name = "=繪圖資料!$G$1"
End With
With Worksheets("繪圖資料") ' 設定主座標軸最大及最小值
myMax = Application.Max(.Range("C2:C" & CStr(nRow)))
myMin = Application.Min(.Range("D2:D" & CStr(nRow)))
myMin = myMin - (myMax - myMin)
End With
With .Axes(xlValue)
.MaximumScale = Round(myMax, 2)
.MinimumScale = Round(myMin, 2)
End With
.SeriesCollection.NewSeries ' 新增成交量數列
With .SeriesCollection(6)
.Values = Worksheets("繪圖資料").Range("F2:F" & CStr(nRow))
.ChartType = xlColumnClustered
.Name = "成交量"
.Interior.ColorIndex = 17
.AxisGroup = xlSecondary ' 設為副座標軸
End With
With Worksheets("繪圖資料") ' 計算副座標軸最大及最小值
myMax = Application.Max(.Range("F2:F" & CStr(nRow)))
myMax = myMax * 2
myMin = 0.01
End With
With .Axes(xlValue, xlSecondary) ' 設定副座標軸最大及最小值
.MaximumScale = Round(myMax, 0)
.MinimumScale = Round(myMin, 0)
End With
With .Axes(xlCategory) ' X座標軸 (時間軸)
.CategoryType = xlCategoryScale
.TickLabelSpacing = 4 ' 標示間距
.TickLabels.NumberFormatLocal = "yyyy/m/d"
.TickLabels.Font.ColorIndex = 5 ' Blue Color
End With
With .Legend ' 刪除不必要的圖例
.LegendEntries(2).Delete ' 開盤價
.LegendEntries(2).Delete ' 最高價
.LegendEntries(2).Delete ' 最低價
.LegendEntries(2).Delete ' 收盤價
.Top = .Parent.ChartTitle.Top - 5
End With
' With .ChartArea
' .Border.Weight = 2
' .Border.LineStyle = 0
' ' 圖表的繪圖區外之 X、Y 軸列示資料數據區塊部分予以填入圖表預設(系統)之底色、可增強視覺效果。
' .Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, Degree:=0.231372549019608
' ' .Fill.Visible = True ' 加入圖表底色變數內給于之色系。
' ' .Fill.ForeColor.SchemeColor = 圖表底色
' End With
With .PlotArea ' 調整繪圖區域大小與位置
.Top = .Top - 10
.Height = .Height + 10
.Width = .Width + 95
End With
.PlotArea.Select ' 將圖表的繪圖區格線灰黑顏色修改成淡青色、以及表格實線改以虛線表示
.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.8000000119
.Transparency = 0
.Weight = 0.25
.DashStyle = msoLineSysDash
End With
End With
.[A1].Select
End With
End Sub

複製代碼

作者: c_c_lai 時間: 2013-6-12 06:28

回復 21# lin_6219

Sub KChartWithVolume2() ' K線圖與成交量圖放在同一圖表
Dim nRow As Integer, ChtObj As ChartObject
Dim i As Integer, j As Integer, chartname As String
Dim myMax, myMin, GapNr As Integer
On Error Resume Next
With Worksheets("主畫面")
.ChartObjects.Delete
.Select
nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
' Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
' With ChtObj.Chart ~ End With
' 此範例改以 Worksheets("主畫面").Shapes.AddChart.Select 的方式處理；
' With ActiveChart
' . . . . . . . . . . . .
' With .ChartArea
' .Height = 250
' .Width = 450
' End With
' . . . . . . . . . . . .
' chartname = Trim(Replace(ActiveChart.Name, ActiveSheet.Name, ""))
' .Shapes(chartname).Left = Cells(1, 1).Left
' .Shapes(chartname).Top = Cells(1, 1).Top
' . . . . . . . . . . . .
' End With
' 同理，亦可以使用 Worksheets("主畫面").ChartObjects.Add() 的方式處理
' 差別只在於 With ActiveChart ~ End With 間，要另行宣告圖表高、寬度，以及座標位置。
' 換言之， Worksheets("主畫面").ChartObjects.Add() 是一次便宣告完成，宣告物件不同。
.Shapes.AddChart.Select
' With ChtObj.Chart
With ActiveChart
' .SetSourceData Worksheets("繪圖資料").Range("A2:E" & CStr(nRow))
.SetSourceData Source:=Range("繪圖資料!$A$2:繪圖資料!$E$" & CStr(nRow))
.ChartType = xlStockOHLC
.HasTitle = True
.ChartTitle.Characters.Text = "K線與成交量圖"
With .ChartGroups(1)
.AxisGroup = xlPrimary
.HasUpDownBars = True
.UpBars.Interior.ColorIndex = 3
.DownBars.Interior.ColorIndex = 1
.GapWidth = 10
End With
' .SeriesCollection.Add Worksheets("繪圖資料").Range("G1:G" & CStr(nRow))
.SeriesCollection.Add Source:=Range("繪圖資料!$G$2:繪圖資料!$G$" & CStr(nRow))
With .SeriesCollection(5)
.ChartType = xlXYScatterLinesNoMarkers
' .ChartType = xlLine
.AxisGroup = xlPrimary
' 如果主座標值為 xlStockOHLC，此處宣告會被忽視，視同 xlSecondary。
.Border.ColorIndex = 7
.Name = "=繪圖資料!$G$1"
End With
With Worksheets("繪圖資料") ' 設定主座標軸最大及最小值
myMax = Application.Max(.Range("C2:C" & CStr(nRow)))
myMin = Application.Min(.Range("D2:D" & CStr(nRow)))
myMin = myMin - (myMax - myMin)
End With
With .Axes(xlValue)
.MaximumScale = Round(myMax, 2)
.MinimumScale = Round(myMin, 2)
End With
' .SeriesCollection.NewSeries ' 新增成交量數列 (與下述宣告結果一致)
.SeriesCollection.Add Source:=Range("繪圖資料!$F$2:繪圖資料!$F$" & CStr(nRow))
With .SeriesCollection(6)
' 此處 .Values 存放值範圍必須是指向 "有實體數據資料" 範圍區域。
' 如果使用 .SeriesCollection.NewSeries 宣告，則必須指明 .Values。
' .Values = Worksheets("繪圖資料").Range("F2:F" & CStr(nRow))
.ChartType = xlColumnClustered
.Name = "成交量" ' "=繪圖資料!$F$1" (成交金額)
.Interior.ColorIndex = 17
.AxisGroup = xlSecondary ' 設為副座標軸
End With
With Worksheets("繪圖資料") ' 計算副座標軸最大及最小值
myMax = Application.Max(.Range("F2:F" & CStr(nRow)))
myMax = myMax * 2
myMin = 0.01
End With
With .Axes(xlValue, xlSecondary) ' 設定副座標軸最大及最小值
.MaximumScale = Round(myMax, 0)
.MinimumScale = Round(myMin, 0)
End With
With .Axes(xlCategory) ' X座標軸 (時間軸)
.CategoryType = xlCategoryScale
.TickLabelSpacing = 4 ' 標示間距
.TickLabels.NumberFormatLocal = "yyyy/m/d"
.TickLabels.Font.ColorIndex = 5 ' Blue Color
End With
With .Legend ' 刪除不必要的圖例
.LegendEntries(2).Delete ' 開盤價
.LegendEntries(2).Delete ' 最高價
.LegendEntries(2).Delete ' 最低價
.LegendEntries(2).Delete ' 收盤價
.Top = .Parent.ChartTitle.Top - 5
End With
With .ChartArea
.Height = 250 ' 將原本設定之高度調至適度位置
.Width = 450
.Border.Weight = 2
.Border.LineStyle = 0
' 圖表的繪圖區外之 X、Y 軸列示資料數據區塊部分予以填入圖表預設(系統)之底色、可增強視覺效果。
.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, Degree:=0.231372549019608
' .Fill.Visible = True ' 加入圖表底色變數內給于之色系。
' .Fill.ForeColor.SchemeColor = 圖表底色
End With
With .PlotArea ' 調整繪圖區域大小與位置
.Top = .Top - 10
.Height = .Height + 15
.Width = .Width + 95
End With
.PlotArea.Select ' 將圖表的繪圖區格線灰黑顏色修改成淡青色、以及表格實線改以虛線表示
.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.8000000119
.Transparency = 0
.Weight = 0.25
.DashStyle = msoLineSysDash
End With
End With
chartname = Trim(Replace(ActiveChart.Name, ActiveSheet.Name, ""))
.Shapes(chartname).Left = Cells(1, 1).Left ' 設定此圖表實際擺放的 X、Y 座標位置。
.Shapes(chartname).Top = Cells(1, 1).Top
.[A1].Select
End With
End Sub

複製代碼

作者: c_c_lai 時間: 2013-6-12 06:29

回復 21# lin_6219

Sub KChartWithVolume3() ' K線圖與成交量圖放在同一圖表
Dim nRow As Integer, ChtObj As ChartObject
Dim i As Integer, j As Integer
Dim myMax, myMin, GapNr As Integer
On Error Resume Next
Worksheets("主畫面").ChartObjects.Delete
nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
With ChtObj.Chart
.SetSourceData Worksheets("繪圖資料").Range("B2:E" & CStr(nRow))
.ChartType = xlStockOHLC
.HasTitle = True
.ChartTitle.Characters.Text = "K線與成交量圖"
With .ChartGroups(1)
.AxisGroup = xlPrimary
.HasUpDownBars = True
.UpBars.Interior.ColorIndex = 3
.DownBars.Interior.ColorIndex = 1
.GapWidth = 10
End With
.SeriesCollection.Add Worksheets("繪圖資料").Range("G2:G" & CStr(nRow))
With .SeriesCollection(5)
.ChartType = xlXYScatterLinesNoMarkers
' .ChartType = xlLine
.AxisGroup = xlPrimary
.Border.ColorIndex = 7
.Name = "=繪圖資料!$G$1"
End With
With Worksheets("繪圖資料") ' 設定主座標軸最大及最小值
myMax = Application.Max(.Range("C2:C" & CStr(nRow)))
myMin = Application.Min(.Range("D2:D" & CStr(nRow)))
myMin = myMin - (myMax - myMin)
End With
With .Axes(xlValue)
.MaximumScale = Round(myMax, 2)
.MinimumScale = Round(myMin, 2)
End With
.SeriesCollection.NewSeries ' 新增成交量數列
With .SeriesCollection(6)
.Values = Worksheets("繪圖資料").Range("F2:F" & CStr(nRow))
.ChartType = xlColumnClustered
.Name = "成交量"
.Interior.ColorIndex = 17
.AxisGroup = xlSecondary ' 設為副座標軸
End With
With Worksheets("繪圖資料") ' 計算副座標軸最大及最小值
myMax = Application.Max(.Range("F2:F" & CStr(nRow)))
myMax = myMax * 2
myMin = 0.01
End With
With .Axes(xlValue, xlSecondary) ' 設定副座標軸最大及最小值
.MaximumScale = Round(myMax, 0)
.MinimumScale = Round(myMin, 0)
End With
With .Axes(xlCategory) ' X座標軸 (時間軸)
.CategoryType = xlCategoryScale
.TickLabelSpacing = 4 ' 標示間距
.TickLabels.NumberFormatLocal = "yyyy/m/d"
.TickLabels.Font.ColorIndex = 5 ' Blue Color
End With
With .Legend ' 刪除不必要的圖例
.LegendEntries(2).Delete ' 開盤價
.LegendEntries(2).Delete ' 最高價
.LegendEntries(2).Delete ' 最低價
.LegendEntries(2).Delete ' 收盤價
.Top = .Parent.ChartTitle.Top - 5
End With
With .PlotArea ' 調整繪圖區域大小與位置
.Top = .Top - 10
.Height = .Height + 10
.Width = .Width + 95
End With
.PlotArea.Select ' 將圖表的繪圖區格線灰黑顏色修改成淡青色、以及表格實線改以虛線表示
.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.8000000119
.Transparency = 0
.Weight = 0.25
.DashStyle = msoLineSysDash
End With
End With
Worksheets("主畫面").[A1].Select
End Sub

複製代碼

作者: c_c_lai 時間: 2013-6-12 06:31

回復 21# lin_6219

Sub Test()
Dim nRow As Integer, ChtObj As ChartObject
Dim i As Integer, j As Integer, chartname As String
Dim myMax, myMin, GapNr As Integer
On Error Resume Next
With Worksheets("主畫面")
.ChartObjects.Delete
.Select
nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
With ChtObj.Chart
' .SetSourceData Source:=Range("繪圖資料!$A$2:繪圖資料!$A$20, 繪圖資料!$F$2:繪圖資料!$F$20")
.SetSourceData Source:=Range("繪圖資料!$A$2:繪圖資料!$A$" & CStr(nRow) & ", 繪圖資料!$F$2:繪圖資料!$F$" & CStr(nRow))
.ChartType = xlXYScatterLinesNoMarkers
' .ChartType = xlLine
.HasTitle = True
.ChartTitle.Characters.Text = "K線與成交量圖"
With .SeriesCollection(1)
.Border.ColorIndex = 7
.Name = "=繪圖資料!$F$1"
End With
With .Axes(xlCategory) ' X座標軸 (時間軸)
.CategoryType = xlCategoryScale
.TickLabelSpacing = 4 ' 標示間距
.TickLabels.NumberFormatLocal = "yyyy/m/d"
.TickLabels.Font.ColorIndex = 5 ' Blue Color
' .TickLabels.Orientation = xlTickLabelOrientationUpward
End With
End With
End With
End Sub

複製代碼

作者: lin_6219 時間: 2013-6-12 15:35

回復 26# c_c_lai
好的，我再好好仔細研究看看，圖表這個部分，狀況真的很多呢，十分感謝你:)))

作者: lin_6219 時間: 2013-6-12 21:34

回復 26# c_c_lai
不好意思，我想再請問說，如果是成交量這種圖，而且是用西元年，那有辦法避免掉嗎? 感謝。[attach]15243[/attach]
圖表類型為 xlColumnClustered

作者: c_c_lai 時間: 2013-6-13 06:37

本帖最後由 c_c_lai 於 2013-6-13 06:42 編輯

回復 28# lin_6219
基本上，圖表在運作時，它並不會理會是西元、或民國年，
只是在顯示時發生轉換上的問題。
原則上，如果我選用民國年作為檔案的日期欄，在此情況下
.TickLabels.NumberFormatLocal = "m/d" 應該會是我的選擇。
至於在 xlColumnClustered 下，我是沒試過點位的問題。

作者: c_c_lai 時間: 2013-6-13 07:02

回復 28# lin_6219
經測試 xlColumnClustered、xlColumnStacked、xl3DColumnStacked、
xl3DColumnClustered 等，結果都是一般正常的點位。如圖：
[attach]15245[/attach]
這方面可能要直接請教 Microsoft 或自行上網搜尋相關資料了。

作者: lin_6219 時間: 2013-6-13 15:44

回復 30# c_c_lai
好的，那這樣我瞭解了，非常感謝你很詳細的解答我的問題，謝謝:)))

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)