請問有人有用vba做過大盤的河流圖嗎
請問有人有用vba做過大盤的河流圖嗎如何做
謝謝:P 用錄製巨集，我只可各別錄股價圖、折線圖
請問如何做在一起，謝謝 例如附件中的檔案 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=55743&ptid=9865]3#[/url] [i]wufonna[/i] [/b]
依你附檔所寫的,試試看[code]Sub Ex()
Dim E As Variant
Dim Rng(1 To 2) As Range
With 工作表1 '工作表 (Sheet 物件)
Set Rng(1) = .Range(.[B1], .[B1].End(xlDown)).Resize(, 4) '第一圖表來源資料範圍
Set Rng(2) = .Range(.[I1], .[I1].End(xlDown)).Resize(, 4) '第二圖表來源資料範圍
.ChartObjects.Delete '刪除所有圖表
For Each E In Rng
'ChartObjects 方法，該物件既可代表單一內嵌圖表 (ChartObject 物件)、也可代表工作表上所有內嵌圖表的集合 (ChartObjects 物件)。
With .ChartObjects.Add(E.Left, E.Top, E.Resize(, 11).Width, E.Resize(15).Height).Chart 'Chart(物件)
'新增圖表 Add( 左邊位置 , 上方位置 , 圖表寬度 ,圖表高度 )
.ChartType = xlLine '指定圖表類型
.SetSourceData E '為指定圖表設定來源資料範圍。
.SeriesCollection(1).XValues = E.Parent.Range("A2:A" & E.Rows.Count - 1) 'X軸的標籤位置
.Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy/m/d;@" 'X軸的標籤數值格式
End With
Next
End With
End Sub
[/code] 謝謝 GBKEE 大
執行後還是兩個圖表
希望執行後像 img.JPG 這樣
謝謝 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=55746&ptid=9865]5#[/url] [i]wufonna[/i] [/b]
依你附檔的資料所寫,如有須再修改請自行,用錄製巨集的程式碼修改試試看.[code]Sub Ex()
Dim E As Variant, I As Integer
Dim Rng(1 To 2) As Range
With 工作表1 '工作表 (Sheet 物件)
Set Rng(1) = .Range(.[B2], .[B2].End(xlDown)).Resize(, 4) '第一圖表來源資料範圍
Set Rng(2) = .Range(.[I2], .[I2].End(xlDown)).Resize(, 4) '第二圖表來源資料範圍
.ChartObjects.Delete '刪除所有圖表
'ChartObjects 方法，該物件既可代表單一內嵌圖表 (ChartObject 物件)、也可代表工作表上所有內嵌圖表的集合 (ChartObjects 物件)。
With .ChartObjects.Add(Rng(1).Left, Rng(1).Top, Rng(1).Resize(, 11).Width, Rng(1).Resize(15).Height).Chart 'Chart(物件)
'新增圖表 Add( 左邊位置 , 上方位置 , 圖表寬度 ,圖表高度 )
.ChartType = xlLine '指定圖表類型
'.SetSourceData Union(Rng(1), Rng(2)) '為指定圖表設定來源資料範圍。
For Each E In Rng(1).Columns '
.SeriesCollection.NewSeries '新增數列
I = .SeriesCollection.Count
.SeriesCollection(I).Values = E
.SeriesCollection(I).Name = E.Cells(0).Text
Next
For Each E In Rng(2).Columns
.SeriesCollection.NewSeries
I = .SeriesCollection.Count
.SeriesCollection(I).Values = E
.SeriesCollection(I).Name = E.Cells(0).Text
.SeriesCollection(I).AxisGroup = xlSecondary
Next
.SeriesCollection(1).XValues = Parent.Parent.Range("A2:A" & Rng(1).Rows.Count - 1) 'X軸的標籤位置
.Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy/m/d;@" 'X軸的標籤數值格式
With .Axes(xlValue) 'Y(主)座標軸
.MinimumScale = Application.Min(Rng(1)) '最小值
.MaximumScale = Application.Max(Rng(1)) '最大值
.MajorUnitIsAuto = True '主要刻度間距=自動設定
.MinorUnitIsAuto = True '次要刻度間距=自動設定
.Crosses = xlAutomatic '座標軸與其他座標軸交叉的點=自動設定
.ScaleType = xlLinear '數值座標軸的刻度類型=xlLinear
End With
With .Axes(xlValue, xlSecondary) 'Y(副)座標軸
.MinimumScale = Application.Min(Rng(2)) '最小值
.MaximumScale = Application.Max(Rng(2)) '最大值
.MaximumScaleIsAuto = True
.MajorUnitIsAuto = True
.MinorUnitIsAuto = True
.Crosses = xlAutomatic
.ScaleType = xlLinear
End With
End With
End With
End Sub
[/code] 謝謝 GBKEE 大
我再研究程式碼看看
不會再請教大大
真的非常謝謝^0^ [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=55737&ptid=9865]1#[/url] [i]wufonna[/i] [/b]
[url]http://forum.twbts.com/viewthread.php?tid=10531&pid=118377&page=2&extra=pageD1#pid118377[/url]
頁:
[1]