使用两个数组填充两个 Excel 个图表

Question

我以前问过这个问题，很感谢得到的帮助，但问题仍然存在。我正在尝试绘制根据载荷计算的剪切力和弯矩图。我创建了两个点数组，并将其传递给两个命名图表。

程序在 .SeriesCollection(1).Values = SFnode 和 BMnode 停止。

我的代码

Sub DOGRAPH()

'Calculate the Maximum BM by calculating the area of the SF diagram
    
'Data
    Dim L As Single, UDL As Single, RA As Single

        L = 3 'm
        UDL = 1 'kN/m
        RA = L * UDL / 2
        
'Global variable
    Dim i As Integer
        
'Declare the nodes
    Dim nNodes As Integer
    Dim SFnode() As Variant, BMnode() As Variant 'Graph points
        
    'Number of nodes
        nNodes = L * 1000 'Divide length into mm
        
    ReDim SFnode(nNodes), BMnode(nNodes)
    
'Do the SF and BM Diagrams
    Dim SFsum As Single 'Sum the area of the SF diagram
       
        SFnode(0) = RA       'First Node = RA
        SFsum = 0
        
        For i = 1 To nNodes
            SFnode(i) = RA - UDL * i / 1000 'SF Diagram
            SFsum = SFsum + SFnode(i)
            BMnode(i) = SFsum               'BM Diagram
        Next i
       
    Dim cSF As Chart, cBM As Chart
    
    'The charts have been named in the sheet

    Set cSF = ActiveSheet.ChartObjects("SFdiagram").Chart
    Set cBM = ActiveSheet.ChartObjects("BMdiagram").Chart
        
    With cSF
    
        .SeriesCollection(1).Values = SFnode
   
    End With
       
    With cBM
    
       .SeriesCollection(1).Values = BMnode
        
    End With

    Set cSF = Nothing
    Set cBM = Nothing

    MsgBox "Done"

End Sub

Answer 1

请尝试下一种方法。它处理两种 Cluster Column 图表类型。 已编辑：*

您下载的工作簿中的伪图表不能以这种方式使用。没有任何系列，很明显 cBM.SeriesCollection(1) 在任何情况下都会 return 出错。请删除您现有的图表 和运行下一个代码。首先，它会创建两个聊天和他们的第一个 'Series' 然后它只会 change/refresh 他们的 Series1 系列：

Sub ChartFromArray() 'creation firstly
 Dim sh As Worksheet, arr, cSF As Chart, cBM As Chart

 Set sh = ActiveSheet
 
 arr = makeArrays
 'for SFdiagram chart:_____________________________________________
 On Error Resume Next
  Set cSF = sh.ChartObjects("SFdiagram").Chart
  If Err.Number = -2147024809 Then
      Err.Clear: On Error GoTo 0
      Set cSF = sh.ChartObjects.Add(Left:=1, Top:=10, _
                                    Width:=300, Height:=300).Chart
      cSF.ChartType = xlColumnStacked: cSF.Parent.Name = "SFdiagram"
      cSF.SeriesCollection.NewSeries.Values = arr(0)
  Else
      On Error GoTo 0
      cSF.SeriesCollection(1).Values = arr(0)
  End If:
  '________________________________________________________________
  
  'for BMdiagram chart:_____________________________________________
  On Error Resume Next
   Set cBM = sh.ChartObjects("BMdiagram").Chart
   If Err.Number = -2147024809 Then
      Err.Clear: On Error GoTo 0
      Set cBM = sh.ChartObjects.Add(Left:=cSF.Parent.Width + 5, _
                            Top:=10, Width:=300, Height:=300).Chart
      cBM.ChartType = xlColumnStacked: cBM.Parent.Name = "BMdiagram"
      cBM.SeriesCollection.NewSeries.Values = arr(1)
   Else
       On Error GoTo 0
       cBM.SeriesCollection(1).Values = arr(1)
   End If
   '________________________________________________________________
End Sub

它使用下一个函数来计算两个必要的数组，所以也复制它：

Function makeArrays() As Variant
 Dim L As Single, UDL As Single, RA As Single, i As Integer

    L = 3: UDL = 1: RA = L * UDL / 2 'kN/m
        
    'Declare the nodes
    Dim nNodes As Integer
    Dim SFnode() As Variant, BMnode() As Variant 'Graph points
        
    'Number of nodes
        nNodes = L * 1000 'Divide length into mm
        
    ReDim SFnode(nNodes), BMnode(nNodes)
    
    'Do the SF and BM Diagrams
    Dim SFsum As Single 'Sum the area of the SF diagram
       
    SFnode(0) = RA       'First Node = RA
    SFsum = 0
        
    For i = 1 To nNodes
        SFnode(i) = RA - UDL * i / 1000 'SF Diagram
        SFsum = SFsum + SFnode(i)
        BMnode(i) = SFsum               'BM Diagram
    Next i
  makeArrays = Array(SFnode, BMnode)
End Function

请测试它并发送一些反馈。

使用两个数组填充两个 Excel 个图表

Fill two Excel charts using a two arrays

excel

vba

excel-charts