- 帖子
- 234
- 主題
- 19
- 精華
- 0
- 積分
- 276
- 點名
- 0
- 作業系統
- Windows XP
- 軟體版本
- office 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2013-1-7
- 最後登錄
- 2021-10-7
|
回復 6# iverson105
先輸入所需資料後,再將相關資料帶入圖表
如果有不夠的請依此方式增加要的資料
Sub ALL_PLOT2()
Dim x, y, z, R As Integer
Dim CName(10, 10)
R = 0
Do While y = "" '防止資料為空白
y = Application.InputBox("畫圖次數", "", 1, 350, 150) '輸入要畫幾張圖,預設為1張
If y = "" Then MsgBox "畫圖次數不得為空白!!"
Loop
'----------------------------------輸入各圖表相關資料(所需資料自行增加)-----------
For z = 1 To y
Do While CName(z, 0) = ""
CName(z, 0) = Application.InputBox("第" & z & "圖名", "", "R2R_Ave.G.R." & z, 350, 150) '輸入圖表名稱,預設為R2R_Ave.G.R.1
If CName(z, 0) = "" Then MsgBox "請輸入圖名!!"
Loop
Do While CName(z, 1) = ""
CName(z, 1) = Application.InputBox("第" & z & "圖的MinimumScale", "", "0", 350, 150) '輸入x軸最小座標,預設為0
If CName(z, 1) = "" Then MsgBox "MinimumScale不得為空白!!"
Loop
Do While CName(z, 2) = ""
CName(z, 2) = Application.InputBox("第" & z & "圖的MaximumScale", "", "1000", 350, 150) '輸入x軸最大座標,預設為0
If CName(z, 2) = "" Then MsgBox "MaximumScale不得為空白!!"
Loop
Next
'---------------------------------------------------------------
For z = 1 To y
Sheets("R2R_analysis").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter
Application.ScreenUpdating = False
For x = 2 To Worksheets.Count
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(x - 1).Name = Sheets("工作表1 (" & x & ")").Range("U1").Offset(0, (z - 1))
ActiveChart.SeriesCollection(x - 1).XValues = Sheets("工作表1 (" & x & ")").Range("A2:A20000").Offset(0, (z - 1))
ActiveChart.SeriesCollection(x - 1).Values = Sheets("工作表1 (" & x & ")").Range("D2:D20000").Offset(0, (z - 1))
Next
Application.ScreenUpdating = True
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ActiveChart.ApplyLayout (4)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim xRg As Range
Dim xChart As ChartObject
Set xRg = Range("A20:J50").Offset(0, R)
Set xChart = ActiveSheet.ChartObjects(z)
With xChart
.Top = xRg(z).Top
.Left = xRg(z).Left
.Width = xRg.Width
.Height = xRg.Height
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ActiveChart.SetElement (msoElementChartTitleAboveChart)
Selection.Caption = CName(z, 0)
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
Selection.Caption = "G.R.(mm/hr)"
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
Selection.Caption = "Length(mm)"
ActiveSheet.ChartObjects(z).Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScale = CName(z, 1)
ActiveChart.Axes(xlCategory).MaximumScale = CName(z, 2)
ActiveChart.Axes(xlCategory).MajorUnit = 100
ActiveChart.Axes(xlCategory).MinorUnit = 50
ActiveChart.Axes(xlCategory).CrossesAt = 0
ActiveChart.Axes(xlValue).CrossesAt = 0
ActiveChart.SetElement (msoElementPrimaryValueGridLinesMajor)
ActiveChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
Application.ScreenUpdating = True
R = R + 10 '每張圖表位置間隔
Next
End Sub |
|
發表於 2020-2-17 14:51
| 
