- 帖子
- 27
- 主題
- 11
- 精華
- 0
- 積分
- 38
- 點名
- 0
- 作業系統
- window
- 軟體版本
- window7
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2019-12-12
- 最後登錄
- 2021-4-21
|
VBA 無法在一般ＳＨＨＥＴ中執行？？
請問各位大大
有發生過以下的情形嗎??
以下附上圖檔跟程式碼
謝謝
- 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
|
|
發表於 2020-3-12 13:37
| 
