請問有人有用vba做過大盤的河流圖嗎

wufonna

請問有人有用vba做過大盤的河流圖嗎
如何做
謝謝:P

wufonna

用錄製巨集，我只可各別錄股價圖、折線圖
請問如何做在一起，謝謝

wufonna

例如附件中的檔案

GBKEE

回復 3# wufonna
依你附檔所寫的,試試看

1. Sub Ex()
   
2.     Dim E As Variant
   
3.     Dim Rng(1 To 2) As Range
   
4.     With 工作表1                                                                                 '工作表 (Sheet 物件)
   
5.         Set Rng(1) = .Range(.[B1], .[B1].End(xlDown)).Resize(, 4)                                '第一圖表來源資料範圍
   
6.         Set Rng(2) = .Range(.[I1], .[I1].End(xlDown)).Resize(, 4)                                '第二圖表來源資料範圍
   
7.         .ChartObjects.Delete                                                                     '刪除所有圖表
   
8.         For Each E In Rng
   
9.           'ChartObjects 方法，該物件既可代表單一內嵌圖表 (ChartObject 物件)、也可代表工作表上所有內嵌圖表的集合 (ChartObjects 物件)。
   
10.           With .ChartObjects.Add(E.Left, E.Top, E.Resize(, 11).Width, E.Resize(15).Height).Chart  'Chart(物件)
    
11.                    '新增圖表 Add( 左邊位置 , 上方位置 , 圖表寬度 ,圖表高度 )
    
12.                 .ChartType = xlLine                                                               '指定圖表類型
    
13.                 .SetSourceData E                                                                  '為指定圖表設定來源資料範圍。
    
14.                 .SeriesCollection(1).XValues = E.Parent.Range("A2:A" & E.Rows.Count - 1)          'X軸的標籤位置
    
15.                 .Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy/m/d;@"                     'X軸的標籤數值格式
    
16.           End With
    
17.         Next
    
18.     End With
    
19. End Sub

複製代碼

wufonna

謝謝 GBKEE  大
執行後還是兩個圖表
希望執行後像 img.JPG 這樣
謝謝

GBKEE

回復 5# wufonna
依你附檔的資料所寫,如有須再修改請自行,用錄製巨集的程式碼修改試試看.

1. Sub Ex()
   
2.     Dim E As Variant, I As Integer
   
3.     Dim Rng(1 To 2) As Range
   
4.     With 工作表1                                                                                 '工作表 (Sheet 物件)
   
5.         Set Rng(1) = .Range(.[B2], .[B2].End(xlDown)).Resize(, 4)                                '第一圖表來源資料範圍
   
6.         Set Rng(2) = .Range(.[I2], .[I2].End(xlDown)).Resize(, 4)                                '第二圖表來源資料範圍
   
7.         .ChartObjects.Delete                                                                     '刪除所有圖表
   
8.           'ChartObjects 方法，該物件既可代表單一內嵌圖表 (ChartObject 物件)、也可代表工作表上所有內嵌圖表的集合 (ChartObjects 物件)。
   
9.         With .ChartObjects.Add(Rng(1).Left, Rng(1).Top, Rng(1).Resize(, 11).Width, Rng(1).Resize(15).Height).Chart  'Chart(物件)
   
10.                    '新增圖表 Add( 左邊位置 , 上方位置 , 圖表寬度 ,圖表高度 )
    
11.                 .ChartType = xlLine                                                               '指定圖表類型
    
12.                 '.SetSourceData Union(Rng(1), Rng(2))                                             '為指定圖表設定來源資料範圍。
    
13.                 For Each E In Rng(1).Columns                                                      '
    
14.                     .SeriesCollection.NewSeries                                                   '新增數列
    
15.                     I = .SeriesCollection.Count
    
16.                     .SeriesCollection(I).Values = E
    
17.                     .SeriesCollection(I).Name = E.Cells(0).Text
    
18.                 Next
    
19.                 For Each E In Rng(2).Columns
    
20.                     .SeriesCollection.NewSeries
    
21.                     I = .SeriesCollection.Count
    
22.                     .SeriesCollection(I).Values = E
    
23.                     .SeriesCollection(I).Name = E.Cells(0).Text
    
24.                     .SeriesCollection(I).AxisGroup = xlSecondary
    
25.                 Next
    
26.                 .SeriesCollection(1).XValues = Parent.Parent.Range("A2:A" & Rng(1).Rows.Count - 1)          'X軸的標籤位置
    
27.                 .Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy/m/d;@"                     'X軸的標籤數值格式
    
28.                   With .Axes(xlValue)             'Y(主)座標軸
    
29.                     .MinimumScale = Application.Min(Rng(1))                        '最小值
    
30.                     .MaximumScale = Application.Max(Rng(1))                        '最大值
    
31.                     .MajorUnitIsAuto = True      '主要刻度間距=自動設定
    
32.                     .MinorUnitIsAuto = True      '次要刻度間距=自動設定
    
33.                     .Crosses = xlAutomatic       '座標軸與其他座標軸交叉的點=自動設定
    
34.                     .ScaleType = xlLinear        '數值座標軸的刻度類型=xlLinear
    
35.                 End With
    
36.                 With .Axes(xlValue, xlSecondary) 'Y(副)座標軸
    
37.                     .MinimumScale = Application.Min(Rng(2))                        '最小值
    
38.                     .MaximumScale = Application.Max(Rng(2))                        '最大值
    
39.                     .MaximumScaleIsAuto = True
    
40.                     .MajorUnitIsAuto = True
    
41.                     .MinorUnitIsAuto = True
    
42.                     .Crosses = xlAutomatic
    
43.                     .ScaleType = xlLinear
    
44.                 End With
    
45.         End With
    
46.     End With
    
47. End Sub

複製代碼

wufonna

謝謝 GBKEE  大
我再研究程式碼看看
不會再請教大大
真的非常謝謝^0^

wufonna

回復 1# wufonna


    http://forum.twbts.com/viewthrea ... ra=pageD1#pid118377