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

问题描述

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

程序在 .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

解决方法

请尝试下一个方法。它处理两种簇柱形图类型。 已编辑：*

您下载的工作簿中的伪图表不能以这种方式使用。没有任何系列，很明显 cBM.SeriesCollection(1) 在任何情况下都会返回错误。请删除您现有的图表并运行下一个代码。它首先会创建两个聊天和他们的第一个“系列”，然后它只会更改/刷新他们的 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

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

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

请测试并发送一些反馈。