Board logo

標題: VBA 無法在一般SHHET中執行?? [打印本頁]

作者: iverson105    時間: 2020-3-12 13:37     標題: VBA 無法在一般SHHET中執行??

請問各位大大
有發生過以下的情形嗎??
以下附上圖檔跟程式碼

謝謝
[attach]31781[/attach][attach]31781[/attach]
  1. Sub R2R_PLOTALL()

  2. Dim x, y, z, R As Integer
  3. Dim CName(10, 10)
  4. R = 0
  5. Do While y = ""                                          '防止資料為空白
  6.    y = Application.InputBox("畫圖次數", "", 1, 350, 150) '輸入要畫幾張圖,預設為1張
  7.    If y = "" Then MsgBox "畫圖次數不得為空白!!"
  8. Loop
  9. '----------------------------------輸入各圖表相關資料(所需資料自行增加)-----------
  10. For z = 1 To y
  11. Do While CName(z, 0) = ""
  12.    CName(z, 0) = Application.InputBox("第" & z & "圖名", "", "R2R_CHART." & z, 350, 150) '輸入圖表名稱,預設為R2R_Ave.G.R.1
  13.    If CName(z, 0) = "" Then MsgBox "請輸入圖名!!"
  14. Loop

  15. 'Do While CName(z, 1) = ""
  16.    'CName(z, 1) = Application.InputBox("第" & z & "圖的Y軸_Scale", "", "0", 350, 150)    '輸入x軸最小座標,預設為0
  17.   ' If CName(z, 1) = "" Then MsgBox "Y軸_Scale不得為空白!!"
  18. 'Loop '

  19. 'Do While CName(z, 2) = ""
  20.   ' CName(z, 2) = Application.InputBox("第" & z & "圖的MaximumScale", "", "1000", 350, 150) '輸入x軸最大座標,預設為0
  21.    'If CName(z, 2) = "" Then MsgBox "MaximumScale不得為空白!!"
  22. 'Loop
  23. Next
  24. '---------------------------------------------------------------
  25. For z = 1 To y
  26. Sheets("R2R_analysis").Select
  27. ActiveSheet.Shapes.AddChart.Select
  28. ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
  29. Application.ScreenUpdating = False

  30. For x = 2 To Worksheets.Count
  31.    On Error Resume Next  '''''' 錯誤跳過
  32.    ActiveChart.SeriesCollection.NewSeries
  33.    
  34.    ActiveChart.SeriesCollection(x - 1).Name = Sheets("工作表1 (" & x & ")").Range("U1") ''''.Offset(0, (z - 1))
  35.    ActiveChart.SeriesCollection(x - 1).XValues = Sheets("工作表1 (" & x & ")").Range("A2:A20000") ''''.Offset(0, (z - 1))
  36.    ActiveChart.SeriesCollection(x - 1).Values = Sheets("工作表1 (" & x & ")").Range("D2:D20000").Offset(0, (z - 2))
  37. Next
  38. On Error GoTo 0 '''''''''''''錯誤跳過''''''''
  39. Application.ScreenUpdating = True

  40. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  41. ActiveChart.ApplyLayout (4)

  42. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  43. Dim xRg As Range
  44. Dim xChart As ChartObject
  45. Set xRg = Range("A20:J50").Offset(0, R)
  46. Set xChart = ActiveSheet.ChartObjects(z)
  47. With xChart
  48.    .Top = xRg(z).Top
  49.    .Left = xRg(z).Left
  50.    .Width = xRg.Width
  51.    .Height = xRg.Height
  52. End With

  53. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  54. ActiveChart.SetElement (msoElementChartTitleAboveChart)
  55. Selection.Caption = CName(z, 0)

  56. ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)

  57. For x = 2 To Worksheets.Count
  58. On Error Resume Next  '''''' 錯誤跳過
  59. Selection.Caption = Sheets("工作表1 (" & x & ")").Range("C1").Offset(0, (z - 1))       ''''CName(z, 1) ''''''''"G.R.(mm/hr)"
  60. On Error GoTo 0 '''''''''''''錯誤跳過''''''''
  61. Next

  62. ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
  63. Selection.Caption = "Length(mm)"
  64. ActiveSheet.ChartObjects(z).Activate
  65. ActiveChart.Axes(xlCategory).Select
  66. ActiveChart.Axes(xlCategory).MinimumScale = 0 '''''''CName(z, 1)
  67. ActiveChart.Axes(xlCategory).MaximumScale = 1000 '''''CName(z, 2)
  68. ActiveChart.Axes(xlCategory).MajorUnit = 100
  69. ActiveChart.Axes(xlCategory).MinorUnit = 50
  70. ActiveChart.Axes(xlCategory).CrossesAt = 0
  71. ActiveChart.Axes(xlValue).CrossesAt = 0
  72. ActiveChart.SetElement (msoElementPrimaryValueGridLinesMajor)
  73. ActiveChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
  74. Application.ScreenUpdating = True
  75. R = R + 10 '每張圖表位置間隔
  76. Next
  77. End Sub
複製代碼

作者: jcchiang    時間: 2020-3-12 15:48

回復 1# iverson105

因R+數值不吉利
把R2R_PLOTALL()改掉應該就可以
作者: iverson105    時間: 2020-3-17 10:31

回復 2# jcchiang
可以用了
感激不盡
謝謝




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)