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

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

複製代碼

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

複製代碼