Question

我创建了一个小型控制面板，可自动复制输入的数据，向表中添加新记录并重新处理该记录的单元格。对于插入，宏搜索表的最后一个空行并在那里插入数据。

现在，我想通过将其与表中的记录相关联，在另一个工作表的图表中添加相同的记录。

不幸的是，我的代码没有按预期工作，我不知道为什么。希望你能帮助我！

Sub DatensatzAnlegen()

'Find next clear row
Range("A6:M6").Select
Selection.Copy
CurrentRow = 13
Do Until Range("A" & CurrentRow) = ""
    CurrentRow = CurrentRow + 1
Loop
Cells(CurrentRow, 1).Activate
ActiveSheet.Paste
Range("E9:M9").Select
Selection.Copy
Cells(CurrentRow, 14).Activate
ActiveSheet.Paste

'Recolor cell of the new record
Cells(CurrentRow, 1).Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent1
    .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
End With

'Link data with chart
Sheets("Diagramm").ChartObjects("DiagrammA").Activate
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection.Name = Sheets("Übersicht").Cells(CurrentRow, 1) 'DOES NOT WORK
ActiveChart.FullSeriesCollection.XValues = Sheets("Übersicht").Cells(CurrentRow, 2) 'DOES NOT WORK
ActiveChart.FullSeriesCollection.Values = Sheets("Übersicht").Cells(CurrentRow, 3) 'DOES NOT WORK

'Clear control panel
ActiveSheets.Übersicht
Range("A6:M6").Select
Selection.ClearContents
Range("E9:M9").Select
Selection.ClearContents
End Sub

Answer 1

下面的代码段会将添加的数据行添加到"DiagrammA"工作表中的"Diagramm"图表中。

注意：您有太多不必要的Select，Selection和ActiveSheet。相反，请使用完全限定的对象，例如设置ChartObject：

Set ChtObj = Chtws.ChartObjects("DiagrammA")

并使用With声明：With Dataws等等......

代码评论中的详细解释。

<强> 代码

Option Explicit

Sub DatensatzAnlegen()

Dim CurrentRow As Long
Dim Dataws As Worksheet
Dim Chtws As Worksheet
Dim ChtObj As ChartObject
Dim Ser As Series

' set the worksheet with the data for the chart
Set Dataws = ThisWorkbook.Sheets("Übersicht")

' set the worksheet where the chart is located
Set Chtws = ThisWorkbook.Sheets("Diagramm")

With Dataws ' always qualify all your Range and cells objects
    'Find next clear row
    CurrentRow = .Range("A13").End(xlDown).Row + 1
    .Range("A6:M6").Copy Destination:=.Range("A" & CurrentRow)

    ' the same should apply for the block below
   ' .Range("E9:M9").Copy Destination:=.Range("A" & CurrentRow + 1)

    'Recolor cell of the new record
    With .Cells(CurrentRow, 1).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End With

' set the chart object
Set ChtObj = Chtws.ChartObjects("DiagrammA")

'Link data with chart
With ChtObj
    Set Ser = .Chart.SeriesCollection.NewSeries ' add a new series to chart

    With Ser
        .Name = "=" & Dataws.Cells(CurrentRow, 1).Address(False, False, xlA1, xlExternal)
        .XValues = "=" & Dataws.Cells(CurrentRow, 2).Address(False, False, xlA1, xlExternal)
        .Values = "=" & Dataws.Cells(CurrentRow, 3).Address(False, False, xlA1, xlExternal)
    End With
End With

' rest of your code 

End Sub

如何将记录/单元格链接到Excel中的图表？ FullSeriesCollection

1 个答案: