Как можно распечатать разные диаграммы для разных данных в Excel или VBA? - PullRequest
1 голос
/ 09 марта 2020

Я пытаюсь напечатать один график для каждой строки / таблицы, графики должны иметь одинаковый формат, только данные должны изменяться среди графиков. Мне нужно сделать это для примерно 120 строк / таблиц, поэтому я хотел бы избежать этого вручную, также я бы предпочел не использовать спарклайны, поскольку его формат не подходит для целей анализа.

Я пытался использовать динамическую c диаграмму с кнопкой комбо, но когда я меняю отфильтрованную строку, меняется и каждый скопированный график, что делает невозможным одновременное отображение графиков, показывающих разные строки - одним из решений может быть вставка его в виде изображения, но оно не является оптимальным, поскольку я хотел бы проверить данные для каждого графика, если это необходимо.

Ниже я приведу пример для двух разных «элементов» в исходном наборе данных. около 350/400 строк и около 120 «элементов», каждые 3 строки создают один график.

enter image description here

Графики, которые я создал вручную: (по одному на каждые 3 строки)

для "элемента" xxx:

strong text

Для "элемента" гггг:

enter image description here

Мне нужно напечатать этот тип графика для других различных ~ 120 "элементов", все сразу.

С точки зрения отображения формата диаграммы, см. Ниже для первого графика: enter image description here

Пробел:

enter image description here

Второй квартиль:

enter image description here

Третий квартиль:

enter image description here

и «элемент», который является черной точкой в график:

enter image description here

Те же рассуждения для второго графика, но с учетом трех строк с ггг.

Я надеюсь, что вы можете помочь меня!

Извините за большое количество изображений, но я хотел, чтобы это было понятно!

Заранее спасибо!

Best, Ema

1 Ответ

0 голосов
/ 10 марта 2020

Легко создать типичную процедуру создания диаграммы и использовать параметры для итерации по листу.

Sub makeCharts()
    Dim Ws As Worksheet
    Dim Cht As Chart, Shp As Shape
    Dim obj As ChartObject
    Dim Target As Range, rngShp As Range
    Dim r As Long, n As Long, i As Long

    Set Ws = ActiveSheet

    For Each obj In Ws.ChartObjects
        obj.Delete
    Next

    r = Ws.Range("a" & Rows.Count).End(xlUp).Row
    n = 1
    For i = 3 To r Step 3

        Set rngShp = Ws.Range("k" & n).Resize(10, 8)
        Set Target = Ws.Range("a" & i)
        Set Shp = Ws.Shapes.AddChart
        With Shp
            .Top = rngShp.Top
            .Left = rngShp.Left
            .Width = rngShp.Width
            .Height = rngShp.Height
        End With
        Set Cht = Shp.Chart
        setCharts Target, Cht
        n = n + 12
    Next i
End Sub


Sub setCharts(Target As Range, Cht As Chart)
    Dim Srs As Series
    Dim vColor
    Dim i As Integer

    vColor = Array(RGB(246, 246, 246), RGB(255, 224, 140), RGB(47, 157, 39), RGB(0, 0, 0))

    With Cht
        .ChartType = xlColumnStacked
        .HasLegend = False
        .HasTitle = True
        .ChartTitle.Text = Target.Value
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "OCF Percentiles"
        .Axes(xlValue).MajorUnit = 20
        For Each Srs In .SeriesCollection
            Srs.Delete
        Next Srs

        For i = 0 To 2
            Set Srs = .SeriesCollection.NewSeries
            With Srs
                .Values = Target.Offset(0, 1).Resize(3).Offset(0, i)
                .XValues = Array("A", "D", "I")
                .Format.Fill.ForeColor.RGB = vColor(i)
                If i = 0 Then
                    .Format.Fill.Transparency = 1 '<~~~~~ Transparency was adjusted
                End If
            End With
        Next i
        Set Srs = .SeriesCollection.NewSeries
        With Srs
            .ChartType = xlXYScatter
            .Values = Target.Offset(0, 4).Resize(1, 3)
            .MarkerStyle = xlMarkerStyleSquare
            .MarkerBackgroundColor = vColor(3) 'vbBlack
        End With
    End With
End Sub

Изображение результата

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...