Question

任何人都可以帮我调整以下代码来循环遍历两个数据系列的数据点范围吗？还帮我循环同一工作簿中不同工作表上的多个图表？还有一种方法可以将递增金属.Left = XVal与计算单元格对齐，以便根据显示的数据点的轴/数量自动调整吗？

这是一个XY图表 - 我遇到了代码here，它获取了数据点的坐标，并将数据标签定位在数据系列之上。我在每个图表上都有两个数据系列，我需要将它用于--CollectionCollection 5和SeriesCollection 3.我使用了增量.Left = XVal增量值，以便数据标签按顺序位于图表的顶部。

Public Sub ChangeCoordinates()
    Dim cht As Excel.Chart
    Dim srs As Excel.Series

    Dim i As Long

    Set cht = Application.ActiveChart
    Set srs = cht.SeriesCollection(5)

    For i = 1 To srs.Points.Count
        XVal = ExecuteExcel4Macro("GET.CHART.ITEM(1,1,""S1P" & i & """)")
        YVal = ExecuteExcel4Macro("GET.CHART.ITEM(2,1,""S1P" & i & """)")

        With ActiveChart.SeriesCollection(5).Points(1).DataLabel
            .Left = XVal - 550
            .Top = YVal + 50
        End With

        With ActiveChart.SeriesCollection(5).Points(2).DataLabel
            .Left = XVal - 500
            .Top = YVal + 50
        End With
    Next i
End Sub

Answer 1

要遍历这两个数据系列，您只需添加一个循环：

Public Sub ChangeCoordinates()
    Dim cht As Chartobject
    Dim srs As Excel.Series

    Dim h as Long
    Dim i As Long


    Set cht = Application.ActiveChart

    For h = 3 to 5 step 2

        Set srs = cht.SeriesCollection(h)

        For i = 1 To srs.Points.Count
            XVal = ExecuteExcel4Macro("GET.CHART.ITEM(1,1,""S1P" & i & """)")
            YVal = ExecuteExcel4Macro("GET.CHART.ITEM(2,1,""S1P" & i & """)")

            With ActiveChart.SeriesCollection(h).Points(i).DataLabel 'replaced points(1) with points(i)
                .Left = XVal - 550
                .Top = YVal + 50
            End With

        Next i
    Next h
End Sub

要遍历所有工作表，以及这些工作表上的图表，只需添加更多循环：）

Public Sub ChangeCoordinates()
    Dim cht As chartobject
    Dim srs As Excel.Series
    Dim shtcount as Long
    Dim chtcount as Long
    Dim f as long
    Dim g as Long
    Dim h as Long
    Dim i As Long

    shtcount = thisworkbook.worksheets.count

    For f = 1 to shtcount
        chtcount = thisworkbook.worksheets(f).chartobjects.count
        For g = 1 to chtcount
            Set cht = thisworkbook.worksheets(f).ChartObjects(g)

                For h = 3 to 5 step 2

                    Set srs = cht.Chart.SeriesCollection(h)

                    For i = 1 To srs.Points.Count

                        XVal = ExecuteExcel4Macro("GET.CHART.ITEM(1,1,""S1P" & i & """)")
                        YVal = ExecuteExcel4Macro("GET.CHART.ITEM(2,1,""S1P" & i & """)")

                        With srs.Points(i).DataLabel 'replaced points(1) with points(i)
                            If h = 3 Then
                                .Left = XVal - 550
                                .Top = YVal + 50
                            Else
                                'Insert other values for series 5 here
                            End if
                        End With

                    Next i
                Next h
        Next g
    Next f
End Sub

数据标签的Excel XY图表坐标循环显示多个图表模板

1 个答案: