获取与图表区域重叠的单元格范围

时间:2015-12-03 12:36:49

标签: excel vba charts range

我在一张Excel表格中有几张图表, 在另一个Excel工作表中,我正在创建一个表来列出上面工作表中存在的所有图表,我可以找到图表名称以及它们在哪个工作表中,以及图表类型。

但是我想知道这个图表的单元格范围是什么,即在图表对象所在的单元格之上。我怎么得到这个?

这是我的代码

    Enum myEnum
  xl3DArea = -4098
xl3DAreaStacked = 78
xl3DAreaStacked100 = 79
xl3DBarClustered = 60
xl3DBarStacked = 61
xl3DBarStacked100 = 62
xl3DColumn = -4100
xl3DColumnClustered = 54
xl3DColumnStacked = 55
xl3DColumnStacked100 = 56
xl3DLine = -4101
xl3DPie = -4102
xl3DPieExploded = 70
xlArea = 1
xlAreaStacked = 76
xlAreaStacked100 = 77
xlBarClustered = 57
xlBarOfPie = 71
xlBarStacked = 58
xlBarStacked100 = 59
xlBubble = 15
xlBubble3DEffect = 87
xlColumnClustered = 51
xlColumnStacked = 52
xlColumnStacked100 = 53
xlConeBarClustered = 102
xlConeBarStacked = 103
xlConeBarStacked100 = 104
xlConeCol = 105
xlConeColClustered = 99
xlConeColStacked = 100
xlConeColStacked100 = 101
xlCylinderBarClustered = 95
xlCylinderBarStacked = 96
xlCylinderBarStacked100 = 97
xlCylinderCol = 98
xlCylinderColClustered = 92
xlCylinderColStacked = 93
xlCylinderColStacked100 = 94
xlDoughnut = -4120
xlDoughnutExploded = 80
xlLine = 4
xlLineMarkers = 65
xlLineMarkersStacked = 66
xlLineMarkersStacked100 = 67
xlLineStacked = 63
xlLineStacked100 = 64
xlPie = 5
xlPieExploded = 69
xlPieOfPie = 68
xlPyramidBarClustered = 109
xlPyramidBarStacked = 110
xlPyramidBarStacked100 = 111
xlPyramidCol = 112
xlPyramidColClustered = 106
xlPyramidColStacked = 107
xlPyramidColStacked100 = 108
xlRadar = -4151
xlRadarFilled = 82
xlRadarMarkers = 81
xlStockHLC = 88
xlStockOHLC = 89
xlStockVHLC = 90
xlStockVOHLC = 91
xlSurface = 83
xlSurfaceTopView = 85
xlSurfaceTopViewWireframe = 86
xlSurfaceWireframe = 84
xlXYScatter = -4169
xlXYScatterLines = 74
xlXYScatterLinesNoMarkers = 75
xlXYScatterSmooth = 72
xlXYScatterSmoothNoMarkers = 73

End Enum

Sub ListChartInfo()
'Update 20141112
    Dim appExcel As Application
    Dim objWorkbook As Workbook
    Dim path As String
    path = ActiveWorkbook.path
    Dim St As Worksheet
    Dim NewSt As Worksheet
    Dim Cb As ChartObject

    Dim I, K As Long

    'create new excel application object
    Set appExcel = New Application
    'set the applications visible property to false
    appExcel.Visible = False
    'open the workbook with data
    'Set objWorkbook = appExcel.Workbooks.Open(path & "\Defect Management Dashboard - 20151201 - 002.xlsx")

    'Set objWorkbook = ActiveWorkbook.Sheets("Name of Report").Cells(B, 2)

    Application.ScreenUpdating = False
    Set NewSt = ActiveWorkbook.Sheets("ChartInfo")
    I = 1
    NewSt.Cells(I, 1) = "Chart Name"
    NewSt.Cells(I, 2) = "Sheet Name"
    NewSt.Cells(I, 3) = "Chart Type"
    NewSt.Cells(I, 4) = "Shape Range"
    NewSt.Cells(I, 5) = "Full Path"

    'NewSt.Cells(I, 6) = "Type"
    'NewSt.Cells(I, 6) = "Location"
    For sCounter = 2 To 50
        'Either we can put all names in an array , here we are printing all the names in Sheet 2
        path = Sheets("NameofReport").Range("B" & sCounter).Value
        If path = "" Then
            GoTo A
        Else
            Set objWorkbook = appExcel.Workbooks.Open(path)
            With NewSt

        For Each St In objWorkbook.Worksheets
            For Each Cb In St.ChartObjects
                I = I + 1
                .Cells(I, 1).Value = Cb.Name
                .Cells(I, 2).Value = St.Name
                 On Error Resume Next
                '.Cells(I, 3).Value = Cb.Chart.ChartType
                .Cells(I, 3).Value = getEnumName(Cb.Chart.ChartType)

                .Cells(I, 4).Value = Cb.Chart



                .Cells(I, 5).Value = path
                '.Cells(I, 5).Value = Cb.QueryTable.CommandType
                On Error GoTo 0
                '.Cells(I, 7).Value = tb.ResultRange
            Next
        Next
        .Activate
    End With
            'close the workbooks
            objWorkbook.Close
            'close the application
            appExcel.Quit
    End If
A:

Next sCounter
Application.ScreenUpdating = True
End Sub


Function getEnumName(eValue As myEnum) As String

  Select Case eValue
    Case -4098
      getEnumName = "xl3DArea"
    Case 78
      getEnumName = "xl3DAreaStacked"
    Case 79
      getEnumName = "xl3DAreaStacked100"
    Case 60
        getEnumName = "xl3DBarClustered"
    Case 61
        getEnumName = "xl3DBarStacked"
    Case 62
        getEnumName = "xl3DBarStacked100"
    Case -4100
        getEnumName = "xl3DColumn"
    Case 54
        getEnumName = "xl3DColumnClustered"
    Case 55
        getEnumName = "xl3DColumnStacked"
    Case 56
        getEnumName = "xl3DColumnStacked100"
    Case -4101
        getEnumName = "xl3DLine"
    Case -4102
        getEnumName = "xl3DPie"
    Case 70
        getEnumName = "xl3DPieExploded"
    Case 1
        getEnumName = "xlArea"
    Case 76
        getEnumName = "xlAreaStacked"
    Case 77
        getEnumName = "xlAreaStacked100"
    Case 57
        getEnumName = "xlBarClustered"
    Case 71
        getEnumName = "xlBarOfPie"
    Case 58
        getEnumName = "xlBarStacked"
    Case 59
        getEnumName = "xlBarStacked100"
    Case 15
        getEnumName = "xlBubble"
    Case 87
        getEnumName = "xlBubble3DEffect"
    Case 51
        getEnumName = "xlColumnClustered"
    Case 52
        getEnumName = "xlColumnStacked"
    Case 53
        getEnumName = "xlColumnStacked100"
    Case 102
        getEnumName = "xlConeBarClustered"
    Case 103
        getEnumName = "xlConeBarStacked"
    Case 104
        getEnumName = "xlConeBarStacked100"
    Case 105
        getEnumName = "xlConeCol"
    Case 99
        getEnumName = "xlConeColClustered"
    Case 100
        getEnumName = "xlConeColStacked"
    Case 101
        getEnumName = "xlConeColStacked100"
    Case 95
        getEnumName = "xlCylinderBarClustered"
    Case 96
        getEnumName = "xlCylinderBarStacked"
    Case 97
        getEnumName = "xlCylinderBarStacked100"
    Case 98
        getEnumName = "xlCylinderCol"
    Case 92
        getEnumName = "xlCylinderColClustered"
    Case 93
        getEnumName = "xlCylinderColStacked"
    Case 94
        getEnumName = "xlCylinderColStacked100"
    Case -4120
        getEnumName = "xlDoughnut"
    Case 80
        getEnumName = "xlDoughnutExploded"
    Case 4
        getEnumName = "xlLine"
    Case 65
        getEnumName = "xlLineMarkers"
    Case 66
        getEnumName = "xlLineMarkersStacked"
    Case 67
        getEnumName = "xlLineMarkersStacked100"
    Case 63
        getEnumName = "xlLineStacked"
    Case 64
        getEnumName = "xlLineStacked100"
    Case 5
        getEnumName = "xlPie"
    Case 69
        getEnumName = "xlPieExploded"
    Case 68
        getEnumName = "xlPieOfPie"
    Case 109
        getEnumName = "xlPyramidBarClustered"
    Case 110
        getEnumName = "xlPyramidBarStacked"
    Case 111
        getEnumName = "xlPyramidBarStacked100"
    Case 112
        getEnumName = "xlPyramidCol"
    Case 106
        getEnumName = "xlPyramidColClustered"
    Case 107
        getEnumName = "xlPyramidColStacked"
    Case 108
        getEnumName = "xlPyramidColStacked100"
    Case -4151
        getEnumName = "xlRadar"
    Case 82
        getEnumName = "xlRadarFilled"
    Case 81
        getEnumName = "xlRadarMarkers"
    Case 88
        getEnumName = "xlStockHLC"
    Case 89
        getEnumName = "xlStockOHLC"
    Case 90
        getEnumName = "xlStockVHLC"
    Case 91
        getEnumName = "xlStockVOHLC"
    Case 83
        getEnumName = "xlSurface"
    Case 85
        getEnumName = "xlSurfaceTopView"
    Case 86
        getEnumName = "xlSurfaceTopViewWireframe"
    Case 84
        getEnumName = "xlSurfaceWireframe"
    Case -4169
        getEnumName = "xlXYScatter"
    Case 74
        getEnumName = "xlXYScatterLines"
    Case 75
        getEnumName = "xlXYScatterLinesNoMarkers"
    Case 72
        getEnumName = "xlXYScatterSmooth"
    Case 73
        getEnumName = "xlXYScatterSmoothNoMarkers"
   Case Else
        getEnumName = "unknown"
  End Select

End Function

3 个答案:

答案 0 :(得分:1)

使用TopLeftCell对象的BottomRightCellChartObject属性。在下面的例子中,我用浅橙色突出显示了与图表区域重叠的单元格;这确实是MsgBox中返回的范围。

Dim co As ChartObject
Dim r As Range

Set co = ActiveChart.Parent
Set r = Range(co.TopLeftCell, co.BottomRightCell)
MsgBox r.Address

enter image description here

答案 1 :(得分:0)

你可以尝试这样的方法来获得图表的图例/数据系列的范围:

Dim oSeries As Series
Dim oChart As ChartObject
Dim oWS As Worksheet

For Each oWS In ActiveWorkbook.Sheets
    For Each oChart In oWS.ChartObjects
        For Each oSeries In oChart.Chart.SeriesCollection
            Debug.Print oSeries.Formula
        Next
    Next
Next

您必须从公式中提取该数据。

BTW:如果你使用后期绑定,你必须将oSeries定义为Object。如果你使用早期绑定(因为你的代码表明你使用像Dim objWorkbook As Workbook这样的东西),那么就不需要那个Enum的东西,因为所有的常量都已经在lib中声明了。

答案 2 :(得分:-1)

最后解决的是我的代码

    Enum myEnum
  xl3DArea = -4098
xl3DAreaStacked = 78
xl3DAreaStacked100 = 79
xl3DBarClustered = 60
xl3DBarStacked = 61
xl3DBarStacked100 = 62
xl3DColumn = -4100
xl3DColumnClustered = 54
xl3DColumnStacked = 55
xl3DColumnStacked100 = 56
xl3DLine = -4101
xl3DPie = -4102
xl3DPieExploded = 70
xlArea = 1
xlAreaStacked = 76
xlAreaStacked100 = 77
xlBarClustered = 57
xlBarOfPie = 71
xlBarStacked = 58
xlBarStacked100 = 59
xlBubble = 15
xlBubble3DEffect = 87
xlColumnClustered = 51
xlColumnStacked = 52
xlColumnStacked100 = 53
xlConeBarClustered = 102
xlConeBarStacked = 103
xlConeBarStacked100 = 104
xlConeCol = 105
xlConeColClustered = 99
xlConeColStacked = 100
xlConeColStacked100 = 101
xlCylinderBarClustered = 95
xlCylinderBarStacked = 96
xlCylinderBarStacked100 = 97
xlCylinderCol = 98
xlCylinderColClustered = 92
xlCylinderColStacked = 93
xlCylinderColStacked100 = 94
xlDoughnut = -4120
xlDoughnutExploded = 80
xlLine = 4
xlLineMarkers = 65
xlLineMarkersStacked = 66
xlLineMarkersStacked100 = 67
xlLineStacked = 63
xlLineStacked100 = 64
xlPie = 5
xlPieExploded = 69
xlPieOfPie = 68
xlPyramidBarClustered = 109
xlPyramidBarStacked = 110
xlPyramidBarStacked100 = 111
xlPyramidCol = 112
xlPyramidColClustered = 106
xlPyramidColStacked = 107
xlPyramidColStacked100 = 108
xlRadar = -4151
xlRadarFilled = 82
xlRadarMarkers = 81
xlStockHLC = 88
xlStockOHLC = 89
xlStockVHLC = 90
xlStockVOHLC = 91
xlSurface = 83
xlSurfaceTopView = 85
xlSurfaceTopViewWireframe = 86
xlSurfaceWireframe = 84
xlXYScatter = -4169
xlXYScatterLines = 74
xlXYScatterLinesNoMarkers = 75
xlXYScatterSmooth = 72
xlXYScatterSmoothNoMarkers = 73

End Enum

Sub ListChartInfo()
'Update 20141112
    Dim appExcel As Application
    Dim objWorkbook As Workbook
    Dim path As String
    path = ActiveWorkbook.path
    Dim St As Worksheet
    Dim NewSt As Worksheet
    Dim Cb As ChartObject
    Dim oSeries As Series
    Dim I, K As Long
    Dim co As ChartObject
    'create new excel application object
    Set appExcel = New Application
    'set the applications visible property to false
    appExcel.Visible = False
    'open the workbook with data
    'Set objWorkbook = appExcel.Workbooks.Open(path & "\Defect Management Dashboard - 20151201 - 002.xlsx")

    'Set objWorkbook = ActiveWorkbook.Sheets("Name of Report").Cells(B, 2)

    Application.ScreenUpdating = False
    Set NewSt = ActiveWorkbook.Sheets("Charts")
    I = 1
    NewSt.Cells(I, 1) = "Chart Name"
    NewSt.Cells(I, 2) = "Sheet Name"
    NewSt.Cells(I, 3) = "Chart Type"
    NewSt.Cells(I, 4) = "Chart Location"
    NewSt.Cells(I, 5) = "Full Path"

    'NewSt.Cells(I, 6) = "Type"
    'NewSt.Cells(I, 6) = "Location"
    For sCounter = 2 To 50
        'Either we can put all names in an array , here we are printing all the names in Sheet 2
        path = Sheets("NameofReport").Range("B" & sCounter).Value
        If path = "" Then
            GoTo A
        Else
            Set objWorkbook = appExcel.Workbooks.Open(path)
            With NewSt

        For Each St In objWorkbook.Worksheets
            For Each Cb In St.ChartObjects
                I = I + 1
                .Cells(I, 1).Value = Cb.Name
                .Cells(I, 2).Value = St.Name
                 On Error Resume Next
                '.Cells(I, 3).Value = Cb.Chart.ChartType
                .Cells(I, 3).Value = getEnumName(Cb.Chart.ChartType)
                .Cells(I, 4).Value = "Location:"
                For Each oSeries In Cb.Chart.SeriesCollection
                    .Cells(I, 4).Value = .Cells(I, 4).Value & oSeries.Formula
                Next
                '.Cells(I, 4).Value = Cb.Chart.SeriesCollection.Formula


                .Cells(I, 5).Value = path
                '.Cells(I, 5).Value = Cb.QueryTable.CommandType
                On Error GoTo 0
                '.Cells(I, 7).Value = tb.ResultRange
            Next
        Next
        .Activate
    End With
            'close the workbooks
            'objWorkbook.Close
            'close the application
            'appExcel.Quit
    End If
A:

Next sCounter
Application.ScreenUpdating = True
End Sub


Function getEnumName(eValue As myEnum) As String

  Select Case eValue
    Case -4098
      getEnumName = "xl3DArea"
    Case 78
      getEnumName = "xl3DAreaStacked"
    Case 79
      getEnumName = "xl3DAreaStacked100"
    Case 60
        getEnumName = "xl3DBarClustered"
    Case 61
        getEnumName = "xl3DBarStacked"
    Case 62
        getEnumName = "xl3DBarStacked100"
    Case -4100
        getEnumName = "xl3DColumn"
    Case 54
        getEnumName = "xl3DColumnClustered"
    Case 55
        getEnumName = "xl3DColumnStacked"
    Case 56
        getEnumName = "xl3DColumnStacked100"
    Case -4101
        getEnumName = "xl3DLine"
    Case -4102
        getEnumName = "xl3DPie"
    Case 70
        getEnumName = "xl3DPieExploded"
    Case 1
        getEnumName = "xlArea"
    Case 76
        getEnumName = "xlAreaStacked"
    Case 77
        getEnumName = "xlAreaStacked100"
    Case 57
        getEnumName = "xlBarClustered"
    Case 71
        getEnumName = "xlBarOfPie"
    Case 58
        getEnumName = "xlBarStacked"
    Case 59
        getEnumName = "xlBarStacked100"
    Case 15
        getEnumName = "xlBubble"
    Case 87
        getEnumName = "xlBubble3DEffect"
    Case 51
        getEnumName = "xlColumnClustered"
    Case 52
        getEnumName = "xlColumnStacked"
    Case 53
        getEnumName = "xlColumnStacked100"
    Case 102
        getEnumName = "xlConeBarClustered"
    Case 103
        getEnumName = "xlConeBarStacked"
    Case 104
        getEnumName = "xlConeBarStacked100"
    Case 105
        getEnumName = "xlConeCol"
    Case 99
        getEnumName = "xlConeColClustered"
    Case 100
        getEnumName = "xlConeColStacked"
    Case 101
        getEnumName = "xlConeColStacked100"
    Case 95
        getEnumName = "xlCylinderBarClustered"
    Case 96
        getEnumName = "xlCylinderBarStacked"
    Case 97
        getEnumName = "xlCylinderBarStacked100"
    Case 98
        getEnumName = "xlCylinderCol"
    Case 92
        getEnumName = "xlCylinderColClustered"
    Case 93
        getEnumName = "xlCylinderColStacked"
    Case 94
        getEnumName = "xlCylinderColStacked100"
    Case -4120
        getEnumName = "xlDoughnut"
    Case 80
        getEnumName = "xlDoughnutExploded"
    Case 4
        getEnumName = "xlLine"
    Case 65
        getEnumName = "xlLineMarkers"
    Case 66
        getEnumName = "xlLineMarkersStacked"
    Case 67
        getEnumName = "xlLineMarkersStacked100"
    Case 63
        getEnumName = "xlLineStacked"
    Case 64
        getEnumName = "xlLineStacked100"
    Case 5
        getEnumName = "xlPie"
    Case 69
        getEnumName = "xlPieExploded"
    Case 68
        getEnumName = "xlPieOfPie"
    Case 109
        getEnumName = "xlPyramidBarClustered"
    Case 110
        getEnumName = "xlPyramidBarStacked"
    Case 111
        getEnumName = "xlPyramidBarStacked100"
    Case 112
        getEnumName = "xlPyramidCol"
    Case 106
        getEnumName = "xlPyramidColClustered"
    Case 107
        getEnumName = "xlPyramidColStacked"
    Case 108
        getEnumName = "xlPyramidColStacked100"
    Case -4151
        getEnumName = "xlRadar"
    Case 82
        getEnumName = "xlRadarFilled"
    Case 81
        getEnumName = "xlRadarMarkers"
    Case 88
        getEnumName = "xlStockHLC"
    Case 89
        getEnumName = "xlStockOHLC"
    Case 90
        getEnumName = "xlStockVHLC"
    Case 91
        getEnumName = "xlStockVOHLC"
    Case 83
        getEnumName = "xlSurface"
    Case 85
        getEnumName = "xlSurfaceTopView"
    Case 86
        getEnumName = "xlSurfaceTopViewWireframe"
    Case 84
        getEnumName = "xlSurfaceWireframe"
    Case -4169
        getEnumName = "xlXYScatter"
    Case 74
        getEnumName = "xlXYScatterLines"
    Case 75
        getEnumName = "xlXYScatterLinesNoMarkers"
    Case 72
        getEnumName = "xlXYScatterSmooth"
    Case 73
        getEnumName = "xlXYScatterSmoothNoMarkers"
   Case Else
        getEnumName = "unknown"
  End Select

End Function

我使用过.Cells(I,4).Value = .Cells(I,4).Value& oSeries.Formula 得到一系列细胞