将图表从单元格范围更改为命名范围

Question

有没有办法通过将图表数据系列从单元格范围更新到命名范围来执行 vba，因为当我移动并复制到同一工作簿中的新工作表时，它会变回单元格范围。

当我移动并复制到另一个工作表时，它将更改为单元格范围，我需要一个 excel vba 来将单元格范围替换为命名范围。图 1 用于表 2，图 2 用于表 3

[1

[2

在下面添加了新图片，如您所见，它会自动更改工作表，我将其移动并复制到新工作表。我只想使用 vba 自动将单元格范围更改为命名范围。 [ [

如果我有更多命名范围怎么办，这个 vba 如何适用于填充图表中每个数据范围中的相同命名范围。

Answer 1

我从 Sheet1 开始，在 sheet1 的上下文中为系列名称、xValues、yValues 和系列绘图顺序创建了 4 个命名范围。

创建工作表副本后，您可以在图片中看到 Excel 也复制了命名范围，但现在位于新工作表名称的上下文中。

您有一个过程 test_updtChartSerie，该过程显示了一个示例，说明如何替换您指定的系列顺序的图表参数（您不需要使用全部）。 在此处设置您命名的范围并尝试。

它可以满足我的需求！尽情享受吧，别忘了检查一下，如果有用就投票吧！

Private Sub test_updtChartSerie()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim wsName As String: wsName = ws.Name
    Dim xtArgs(3) As Variant
    
    ' Example of updating series 1 with multiple named ranges
    Dim xtName$: xtName = "Chart_01"
    Dim sName As String: sName = wsName & "!" & "xt01_s01_name"
    Dim xVal As String: xVal = wsName & "!" & "xt01_axisH"
    Dim yVal As String: yVal = wsName & "!" & "xt01_s01"
    Dim sOrd As Byte: sOrd = 1
    
    ' Set chart arguments
    xtArgs(0) = sName
    xtArgs(1) = xVal
    xtArgs(2) = yVal
    xtArgs(3) = sOrd
    
    Call updtChartSerie(xtName, xtArgs)
End Sub

Private Sub updtChartSerie(xtName As String, xtArgs)
    ' SERIES(<series name>,<x values>,<y values>,<plot order>)
    
    Dim xt As ChartObject
    Dim xtSerie As Series
    Dim sOrder As Byte: sOrder = xtArgs(3)
    
    Dim sFmla As String         ' Series formula
    Dim sFmlaArgs As String     ' String with arguments
       
    ' Get and activate chart
    On Error GoTo errHandler
    Set xt = ActiveSheet.ChartObjects("Chart_01"): xt.Activate
        
    With ActiveChart
        For Each xtSerie In .SeriesCollection
            If xtSerie.PlotOrder = sOrder Then
                ' ' Series formula: before change
                Debug.Print "before: " & .SeriesCollection(sOrder).Formula
                                
                ' Set series formula
                sFmlaArgs = Join(xtArgs, ",")
                sFmla = "=SERIES(" & sFmlaArgs & ")"
                .SeriesCollection(sOrder).Formula = sFmla
                
                ' ' Series formula: after change
                Debug.Print "after :" & .SeriesCollection(sOrder).Formula
                
                Exit For
            End If
        Next xtSerie
    End With
    
exitRoutine:
    Exit Sub
    
errHandler:
    Debug.Print Now() & "; " & Err.Number & "; " & Err.Description
    Resume exitRoutine
End Sub