Блог

В настоящее время я занимаюсь проектом, в котором хочу автоматизировать создание диаграмм в Excel. У меня есть таблицы данных на одном листе, и мне уже удалось использовать VBA для создания графиков из всех таблиц. Поскольку лист может постоянно обновляться новыми таблицами, я хочу расширить свой макрос, чтобы иметь возможность распознавать это. Я полагаю, что мне нужен набор правил для листа. Fx если я добавлю новый заголовок в ячейку в столбце A и раскрашу его, он будет знать, когда я запущу макрос, что на этот раз он должен добавить еще одну диаграмму. Также мне нужна ячейка с каким-то «кодовым» названием, для какого типа диаграммы она должна применяться. Мой макрос привязан к таблицам, которые у меня сейчас есть на листе, и я сделал его динамичным на случай, если я добавлю больше столбцов (когда я добавлю 2022, 2023 и т. Д.). Мне любопытно знать, пробовал ли кто-нибудь это раньше или у кого есть квалифицированное предложение о том, как решить эту проблему, большое вам спасибо!

     Sheets("tables").Select

    Dim xData As Range

    Range("C78", Range("C78").End(xlToRight)).Select
    Set xData = Selection.Cells
    
'---table1---
    Range("B79").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Names.Add Name:="table1Data", RefersToR1C1:= _
        "=Uddybet!R79C2:R82C7"
    ActiveWorkbook.Names("table1Data").Comment = ""

    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=Range("table1Data")
    ActiveChart.FullSeriesCollection(1).XValues = xData
    ActiveChart.ChartTitle.Text = "1"

'---table2---
    Dim colCount As Byte
    
    Range("B79", Range("B79").End(xlToRight)).Select
    colCount = Selection.Cells.Count   2
    
    Dim table2Data As Range
    
    Selection.Offset(0, colCount).Select
    Range(Selection, Selection.End(xlDown)).Select
    Set table2Data = Selection.Cells

    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=table2Data
    ActiveChart.FullSeriesCollection(1).XValues = xData
    ActiveChart.ChartTitle.Text = "2"
    ActiveChart.Axes(xlValue).MaximumScale = 0.16
    
'---table3---
    Dim table3Data As Range
    
    table2Data.Select
    
    Selection.Offset(0, colCount).Select
    Range(Selection, Selection.End(xlDown)).Select
    Set table3Data = Selection.Cells

    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=table3Data
    ActiveChart.FullSeriesCollection(1).XValues = xData
    ActiveChart.ChartTitle.Text = "3"
    ActiveChart.Axes(xlValue).MaximumScale = 0.18

'---table4---  
    Dim table4Data As Range
    
    table3Data.Select
    
    Selection.Offset(0, colCount).Select
    Range(Selection, Selection.End(xlDown)).Select
    Set table4Data = Selection.Cells

    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=table4Data
    ActiveChart.FullSeriesCollection(1).XValues = xData
    ActiveChart.ChartTitle.Text = "4"
    ActiveChart.Axes(xlValue).MaximumScale = 0.2
   
End Sub
 

Я считаю, что лучший способ-это начать:

• преобразование диапазонов в объекты таблицы, они же объекты списка.
• создайте таблицу для управления тем, какие диаграммы следует печатать, здесь она называется «TableChartControl», где у вас также есть тип диаграммы, название диаграммы и то, нужно ли печатать или нет.

С помощью этого решения вы можете добавлять столько таблиц, сколько захотите, и создавать только нужные диаграммы!

 Sub PrintCharts()
    Dim ws As Worksheet: Set ws = Sheets("Tables")
    Dim olControl As ListObject: Set olControl = ws.ListObjects("TableChartControl")
    Dim ol As ListObject
    Dim olCol As Byte
    Dim olColRng As Range, olRng As Range
    Dim aCell As Range
    
    Dim xt As Object
    Dim xtTypeValue As String
    Dim xtType As XlChartType
    Dim xtTitle As String
    
    ' clear table filters
    If olControl.AutoFilter.FilterMode Then olControl.AutoFilter.ShowAllData
    
    ' filter chart to be printed
    olCol = olControl.ListColumns("Print").Index
    olControl.Range.AutoFilter field:=olCol, Criteria1:="yes"
    
    ' check for visible rows
    On Error Resume Next
    Dim olRowsVisible As Integer
    olRowsVisible = olControl.ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Count
    On Error GoTo 0
    
    ' copy only if any rows visible
    If olRowsVisible = 0 Then Exit Sub
    
    ' list of charts to be created
    olCol = olControl.ListColumns("TableName").Index
    Set olColRng = olControl.ListColumns(olCol).DataBodyRange.SpecialCells(xlCellTypeVisible)
            
    ' print charts
    For Each aCell In olColRng
        ' Select table
        Set ol = ws.ListObjects(aCell.Value)
        Application.GoTo ol.Range

        xtTypeValue = aCell.Offset(0, olControl.ListColumns("XlChartType").Index - 1).Value
        xtTitle = aCell.Offset(0, olControl.ListColumns("ChartTitle").Index - 1).Value
        
        ' type of chart
        Select Case xtTypeValue
            Case "xlLineMarkers": xtType = xlLineMarkers
            Case "xlLine": xtType = xlLine
            Case "xlColumnClustered": xtType = xlColumnClustered
            Case "xlColumnStacked": xtType = xlColumnStacked
        End Select

        ' Create chart
        ' https://docs.microsoft.com/en-us/office/vba/api/excel.xlcharttype
        Set xt = ws.Shapes.AddChart2
        With xt.Chart
            .ChartType = xtType
            .ChartTitle.Caption = xtTitle
        End With
    Next aCell
    
    ' clear table filter
    If olControl.AutoFilter.FilterMode Then olControl.AutoFilter.ShowAllData
    
    ' clear
    Set xt = Nothing
    Set ol = Nothing
    Set olControl = Nothing
End Sub