使用两个数组填充两个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

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

您的伪图表表单-下载的工作簿不能以这种方式使用。在没有任何序列的情况下，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

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

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

请测试并发送一些反馈。