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

Sub R2R_PLOTALL()
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_CHART." & 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 & "圖的Y軸_Scale", "", "0", 350, 150) '輸入x軸最小座標,預設為0
' If CName(z, 1) = "" Then MsgBox "Y軸_Scale不得為空白!!"
'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 = xlXYScatterSmoothNoMarkers
Application.ScreenUpdating = False
For x = 2 To Worksheets.Count
On Error Resume Next '''''' 錯誤跳過
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 - 2))
Next
On Error GoTo 0 '''''''''''''錯誤跳過''''''''
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)
For x = 2 To Worksheets.Count
On Error Resume Next '''''' 錯誤跳過
Selection.Caption = Sheets("工作表1 (" & x & ")").Range("C1").Offset(0, (z - 1)) ''''CName(z, 1) ''''''''"G.R.(mm/hr)"
On Error GoTo 0 '''''''''''''錯誤跳過''''''''
Next
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
Selection.Caption = "Length(mm)"
ActiveSheet.ChartObjects(z).Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScale = 0 '''''''CName(z, 1)
ActiveChart.Axes(xlCategory).MaximumScale = 1000 '''''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

複製代碼