[發問] 有關excelVBA圖表的問題

lin_6219

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

lin_6219

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

c_c_lai

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

lin_6219

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

c_c_lai

回復 4# lin_6219
試試看！

1. Sub KChartWithVolume()          '  K 線圖 與 成交量圖 放在同一圖表
   
2.     Dim nRow As Integer, ChtObj As ChartObject
   
3.     Dim i As Integer, j As Integer
   
4.     Dim myMax, myMin, GapNr As Integer
   
5.    
   
6.     On Error Resume Next
   
7.    
   
8.     Worksheets("主畫面").ChartObjects.Delete
   
9.     nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
   
10.             
    
11.     With Worksheets("繪圖資料")                  '  設定主座標軸最大及最小值
    
12.         myMax = Application.Max(.Range("C2:C" & CStr(nRow)))
    
13.         myMin = Application.Min(.Range("D2:D" & CStr(nRow)))
    
14.         myMin = myMin - (myMax - myMin)
    
15.     End With
    
16.    
    
17.     ' Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
    
18.     Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 490, 280)
    
19.    
    
20.     With ChtObj.Chart
    
21.         ' .SetSourceData Worksheets("繪圖資料").Range("A2:E" & CStr(nRow))
    
22.         .SetSourceData Source:=Range("繪圖資料!$A$2:繪圖資料!$E$" & CStr(nRow))
    
23.         .ChartType = xlStockOHLC
    
24.         .HasTitle = True
    
25.         .ChartTitle.Characters.Text = "K線與成交量圖"
    
26.    
    
27.         With .ChartGroups(1)
    
28.             .HasUpDownBars = True
    
29.             .UpBars.Interior.ColorIndex = 3
    
30.             .DownBars.Interior.ColorIndex = 1
    
31.             .GapWidth = 10
    
32.         End With
    
33.         
    
34.         .SeriesCollection(1).Name = ""    ' 開盤價
    
35.         .SeriesCollection(2).Name = ""    ' 最高價
    
36.         .SeriesCollection(3).Name = ""    ' 最低價
    
37.         .SeriesCollection(4).Name = ""    ' 收盤價 (成交價)
    
38.         
    
39.         With .Axes(xlValue)
    
40.             .MaximumScale = Round(myMax, 2)
    
41.             .MinimumScale = Round(myMin, 2)
    
42.             '  .MaximumScale = myMax
    
43.             '  .MinimumScale = myMin
    
44.             .MajorUnit = 0.5                        ' 圖表左側數列之間距值設定
    
45.         End With
    
46.             
    
47.         '  .SeriesCollection.Add Worksheets("繪圖資料").Range("G1:G" & CStr(nRow))
    
48.         .SeriesCollection.Add Source:=Range("繪圖資料!$G$1:繪圖資料!$G$" & CStr(nRow))
    
49.         With .SeriesCollection(5)
    
50.             .AxisGroup = 1
    
51.             '  .ChartType = xlXYScatterLinesNoMarkers
    
52.             .ChartType = xlLines
    
53.             .Name = "=繪圖資料!$G$1"    '  移動平均線
    
54.             .Border.ColorIndex = 7
    
55.         End With
    
56.         
    
57.         '  .SeriesCollection.NewSeries       '  新增成交量數列
    
58.         .SeriesCollection.Add Source:=Range("繪圖資料!$F$1:繪圖資料!$F$" & CStr(nRow))
    
59.         With .SeriesCollection(6)
    
60.             .AxisGroup = 2                   '  設為副座標軸
    
61.             '  .Values = Worksheets("繪圖資料").Range("F2:F" & CStr(nRow))
    
62.             .ChartType = xlColumnClustered
    
63.             .Name = "成交量"
    
64.             .Interior.ColorIndex = 17
    
65.         End With
    
66.         
    
67.         With Worksheets("繪圖資料")                      '  計算副座標軸最大及最小值
    
68.             myMax = Application.Max(.Range("F2:F" & CStr(nRow)))
    
69.             myMax = myMax * 2
    
70.             myMin = 0.01
    
71.         End With
    
72.         
    
73.         With .Axes(xlValue, xlSecondary)      '  設定副座標軸最大及最小值
    
74.             .MaximumScale = Round(myMax, 0)
    
75.             .MinimumScale = Round(myMin, 0)
    
76.         End With
    
77.         
    
78.         With .PlotArea                         '  調整繪圖區域大小與位置
    
79.             .Top = .Top - 2
    
80.             .Height = .Height + 10
    
81.             .Width = .Width + 75
    
82.         End With
    
83.         
    
84.         .PlotArea.Select                        ' 將圖表的繪圖區格線灰黑顏色修改成淡青色、以及表格實線改以虛線表示
    
85.         .Axes(xlValue).MajorGridlines.Select
    
86.         With Selection.Format.Line
    
87.             .Visible = msoTrue
    
88.             .ForeColor.ObjectThemeColor = msoThemeColorAccent1
    
89.             .ForeColor.TintAndShade = 0
    
90.             .ForeColor.Brightness = 0.8000000119
    
91.             .Transparency = 0
    
92.             .Weight = 0.25
    
93.             .DashStyle = msoLineSysDash
    
94.         End With
    
95.         
    
96.         With .Legend
    
97.             .Position = xlLegendPositionTop
    
98.             .Top = .Top - 8
    
99.             .Border.ColorIndex = 57
    
100.             .Border.Weight = xlThin
     
101.             .Border.LineStyle = xlContinuous
     
102.             .Interior.ColorIndex = xlNone
     
103.         End With
     
104.     End With
     
105.     Worksheets("主畫面").[A1].Select
     
106. End Sub

複製代碼

c_c_lai

回復 4# lin_6219
附上圖表共參考。

下載 (32.07 KB)

2013-6-8 19:43

c_c_lai

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

lin_6219

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

c_c_lai

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

下載 (32.87 KB)

2013-6-9 06:57

下載 (38.46 KB)

2013-6-9 06:57

下載 (23.67 KB)

2013-6-9 06:57

c_c_lai

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

下載 (32.45 KB)

2013-6-9 07:37

1. Sub KChartWithVolume3()                         '  K線圖與成交量圖放在同一圖表
   
2.     Dim nRow As Integer, ChtObj As ChartObject
   
3.     Dim i As Integer, j As Integer
   
4.     Dim myMax, myMin, GapNr As Integer
   
5.    
   
6.     On Error Resume Next
   
7.   
   
8.     Worksheets("主畫面").ChartObjects.Delete
   
9.     nRow = Worksheets("繪圖資料").Range("A65536").End(xlUp).Row
   
10.     Set ChtObj = Worksheets("主畫面").ChartObjects.Add(1, 1, 450, 250)
    
11.    
    
12.     With ChtObj.Chart
    
13.         .SetSourceData Worksheets("繪圖資料").Range("B2:E" & CStr(nRow))
    
14.         .ChartType = xlStockOHLC
    
15.         .HasTitle = True
    
16.         .ChartTitle.Characters.Text = "K線與成交量圖"
    
17.         .SeriesCollection.Add Worksheets("繪圖資料").Range("G1:G" & CStr(nRow))
    
18.         
    
19.         With .SeriesCollection(5)
    
20.             .ChartType = xlXYScatterLinesNoMarkers
    
21.             '  .ChartType = xlLine
    
22.             .Border.ColorIndex = 7
    
23.             .AxisGroup = xlPrimary
    
24.             .Name = "=繪圖資料!$G$1"
    
25.         End With
    
26.    
    
27.         With .ChartGroups(1)
    
28.             .AxisGroup = xlPrimary
    
29.             .HasUpDownBars = True
    
30.             .UpBars.Interior.ColorIndex = 3
    
31.             .DownBars.Interior.ColorIndex = 1
    
32.             .GapWidth = 10
    
33.         End With
    
34.         
    
35.         With Worksheets("繪圖資料")              '  設定主座標軸最大及最小值
    
36.             myMax = Application.Max(.Range("C2:C" & CStr(nRow)))
    
37.             myMin = Application.Min(.Range("D2:D" & CStr(nRow)))
    
38.             myMin = myMin - (myMax - myMin)
    
39.         End With
    
40.         
    
41.         With .Axes(xlValue)
    
42.             .MaximumScale = Round(myMax, 2)
    
43.             .MinimumScale = Round(myMin, 2)
    
44.         End With
    
45.         
    
46.         .SeriesCollection.NewSeries              '  新增成交量數列
    
47.         With .SeriesCollection(6)
    
48.             .Values = Worksheets("繪圖資料").Range("F2:F" & CStr(nRow))
    
49.             .ChartType = xlColumnClustered
    
50.             .Name = "成交量"
    
51.             .Interior.ColorIndex = 17
    
52.             .AxisGroup = xlSecondary             '  設為副座標軸
    
53.         End With
    
54.         
    
55.         With Worksheets("繪圖資料")              '  計算副座標軸最大及最小值
    
56.             myMax = Application.Max(.Range("F2:F" & CStr(nRow)))
    
57.             myMax = myMax * 2
    
58.             myMin = 0.01
    
59.         End With
    
60.         
    
61.         With .Axes(xlValue, xlSecondary)         '  設定副座標軸最大及最小值
    
62.             .MaximumScale = Round(myMax, 0)
    
63.             .MinimumScale = Round(myMin, 0)
    
64.         End With
    
65.         
    
66.          With .Axes(xlCategory)                               '  X座標軸 (時間軸)
    
67.              .CategoryType = xlCategoryScale
    
68.              .TickLabelSpacing = 3                            '  標示間距
    
69.              .TickLabels.NumberFormatLocal = "yyyy/m/d"
    
70.              .TickLabels.Font.ColorIndex = 5                  '  Blue Color
    
71.         End With
    
72.         
    
73.         With .Legend                                          '  刪除不必要的圖例
    
74.             .LegendEntries(2).Delete
    
75.             .LegendEntries(2).Delete
    
76.             .LegendEntries(2).Delete
    
77.             .LegendEntries(2).Delete
    
78.             .Top = .Parent.ChartTitle.Top - 5
    
79.         End With
    
80.         
    
81.         With .PlotArea                                        '  調整繪圖區域大小與位置
    
82.             .Top = .Top - 10
    
83.             .Height = .Height + 10
    
84.             .Width = .Width + 75
    
85.         End With
    
86.         
    
87.         .PlotArea.Select    '  將圖表的繪圖區格線灰黑顏色修改成淡青色、以及表格實線改以虛線表示
    
88.         .Axes(xlValue).MajorGridlines.Select
    
89.         With Selection.Format.Line
    
90.             .Visible = msoTrue
    
91.             .ForeColor.ObjectThemeColor = msoThemeColorAccent1
    
92.             .ForeColor.TintAndShade = 0
    
93.             .ForeColor.Brightness = 0.8000000119
    
94.             .Transparency = 0
    
95.             .Weight = 0.25
    
96.             .DashStyle = msoLineSysDash
    
97.         End With
    
98.     End With
    
99.     Worksheets("主畫面").[A1].Select
    
100. End Sub

複製代碼