Добавление и удаление строк для гистограммы, созданной VBA

Вопрос:

Мне нужно создать гистограмму в Excel VBA. Я использовал код ниже, но когда я добавляю или удаляю ROW, он не работает.

Мне нужна эта диаграмма на фиксированном диапазоне (K1). Потому что, когда я вычисляю второй раз, он создает другую диаграмму.

Как я могу изменить код, чтобы предотвратить добавление новой диаграммы при настройке источника данных?

enter image description here

Private Sub CommandButton2_Click()
Sheets("Sheet7").Range("F2:H12").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlBarClustered
ActiveChart.SetSourceData Source:=Range("Sheet7!$F$2:$H$12")
ActiveChart.SeriesCollection(1).Name = "=Sheet7!$G$1"
ActiveChart.SeriesCollection(2).Name = "=Sheet7!$H$1"
End Sub

Лучший ответ:

В приведенном ниже примере кода он проверяет, существует ли диаграмма под названием TheChart, а если нет, создается новая. Теперь вы можете добавлять и удалять строки, и диаграмма должна обновляться. Кроме того, если вы добавите новую строку внизу и нажмите кнопку, она будет перерисовывать TheChart не создавая новую.

Диаграмма всегда находится в верхнем левом углу K1 по переменной rngChartTopLeft которую вы можете настроить, если это необходимо.

Код предполагает, что он запущен в модуле Sheet (следовательно, Set ws = Me), и если вы его запускали в стандартном модуле, вы можете установить лист с помощью Set ws = ThisWorkbook.Worksheets("your_sheet").

Option Explicit

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Dim chto As ChartObject
    Dim rngChartTopLeft As Range
    Dim rngData As Range

    ' assumes the code is in a sheet object
    Set ws = Me

    ' top left of chart
    Set rngChartTopLeft = ws.Range("K1")

    ' create chart or get existing chart
    If ws.ChartObjects.Count = 0 Then
        Set chto = ws.ChartObjects.Add( _
            Left:=rngChartTopLeft.Left, _
            Width:=500, _
            Top:=rngChartTopLeft.Top, _
            Height:=500)
        chto.Name = "TheChart"
    Else
        Set chto = ws.ChartObjects("TheChart")
    End If

    ' set chart type
    chto.Chart.ChartType = xlBarClustered

    ' get data range per last row of data
    Set rngData = ws.Range("F2:G" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row)

    ' set new chart range
    chto.Chart.SetSourceData rngData

End Sub

Ответ №1

пожалуйста, проверьте приведенный ниже код:

Option Explicit

Private Sub CommandButton1_Click()
Dim mychart As Shape
Dim lastrow As Long


lastrow = Sheet7.Cells(Rows.Count, "F").End(xlUp).Row

For Each mychart In ActiveSheet.Shapes

If mychart.Name = "CommandButton1" Then GoTo exit_

mychart.Delete

exit_:

Next

Sheets("Sheet7").Range("F2:H" & lastrow).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlBarClustered
ActiveChart.SetSourceData Source:=Range("Sheet7!$F$2:$H$" & lastrow)
ActiveChart.SeriesCollection(1).Name = "=Sheet7!$G$1"
ActiveChart.SeriesCollection(2).Name = "=Sheet7!$H$1"

End Sub

Оцените статью
TechArks.Ru
Добавить комментарий