Можно ли расположить диаграммы на основе одного и того же заголовка диаграммы - одинакового заголовка диаграммы в одной строке

Question

У меня есть много диаграмм на листе, которые я хочу упорядочить по порядку. Я получил код для размещения 3 диаграмм подряд, но я хочу, чтобы диаграммы с одинаковым заголовком находились в одной строке.

 Sub CHART_ARRANGE()

' chart size - adjust as desired
' set one or both to zero to use dimensions of active chart
'   (or first chart if no chart is active)
Const nRowsTall As Long = 0
Const nColsWide As Long = 0

' chart layout - adjust as desired
Const nChartsPerRow As Long = 3
Const nSkipRows As Long = 2
Const nSkipCols As Long = 1
Const nFirstRow As Long = 1
Const nFirstCol As Long = 1

Dim iChart As Long
Dim chtob As ChartObject
Dim dWidth As Double
Dim dHeight As Double
Dim rData As Range
Dim dFirstChartTop As Double
Dim dFirstChartLeft As Double
Dim dRowsBetweenChart As Double
Dim dColsBetweenChart As Double

If ActiveSheet.ChartObjects.Count > 0 Then

With ActiveSheet.Cells(nFirstRow, nFirstCol)
  If nRowsTall * nColsWide > 0 Then
    dWidth = nColsWide * .Width
    dHeight = nRowsTall * .Height
  Else
    If Not ActiveChart Is Nothing Then
      Set chtob = ActiveChart.Parent
    Else
      Set chtob = ActiveSheet.ChartObjects(1)
    End If
    dWidth = chtob.Width
    dHeight = chtob.Height
  End If

  dFirstChartLeft = .Left
  dFirstChartTop = .Top
  dRowsBetweenChart = nSkipRows * .Height
  dColsBetweenChart = nSkipCols * .Width
End With

For iChart = 1 To ActiveSheet.ChartObjects.Count

  Set chtob = ActiveSheet.ChartObjects(iChart)

  With chtob
    .Left = ((iChart - 1) Mod nChartsPerRow) * _
        (dWidth + dColsBetweenChart) + dFirstChartLeft
    .Top = Int((iChart - 1) / nChartsPerRow) * _
        (dHeight + dRowsBetweenChart) + dFirstChartTop
    .Width = dWidth
    .Height = dHeight
  End With

Next

End If

End Sub

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

Answer 1

Реальное кодирование зависит от точных требований. Я сделал быстрый пример, который упорядочивает все графики по заголовкам. Он имеет некоторые ограничения (например, он не выполняет сортировку) и помещает все диаграммы с одинаковыми заголовками в одну строку.

Код использует словарь с заголовком диаграммы в качестве ключей, логической позицией (содержащей строки и столбцы) и значением.

Он перебирает все графики, выбирает заголовок и проверяет, есть ли заголовок в словаре. Если да, он получает позицию предыдущего графика с тем же заголовком и увеличивает логический столбец на 1. Если нет, в словарь добавляется новая логическая строка (строка = размер словаря и столбец = 0).

Диаграмма размещается путем вычисления Width и Height с использованием логической позиции, умноженной на некоторые константы.

Sub sortChartsByTitle()

    Const startX = 50    ' Left margin
    Const startY = 50    ' Top margin
    Const deltaX = 400 
    Const deltay = 260

    Dim chartTitleList As Dictionary, co As ChartObject
    Dim chartPos As cPos

    Set chartTitleList = New Dictionary
    For Each co In ActiveSheet.ChartObjects
        Dim title As String
        title = ""
        If co.Chart.HasTitle Then
            title = co.Chart.ChartTitle.Text    ' Get ChartTitle (if any)
        End If
        If title = "" Then
            title = "(no title)"    ' Set a default if chart has no title or title is empty
        End If

        If chartTitleList.Exists(title) Then
            ' There was already one chart with same title.
            Set chartPos = chartTitleList(title) ' Get logical position 
            chartPos.col = chartPos.col + 1      ' Jump one to the left
            Set chartTitleList(title) = chartPos ' Remember thus new position
        Else
            Set chartPos = New cPos              ' Create a new logical position
            chartPos.row = chartTitleList.Count  ' Row = size of dictionary
            chartPos.col = 0                     ' Col = 0
            Call chartTitleList.Add(title, chartPos) ' Add to Dictionary
        End If

        ' Position chart
        co.Left = startX + chartPos.col * deltaX
        co.Top = startY + chartPos.row * deltay
    Next co
End Sub

Вам нужен тип объекта для хранения логической позиции, поэтому добавьте модуль класса с именем cPos. Все, что вам нужно, есть (конечно, вы можете обернуть это с помощью сеттера и геттера ...)

Option Explicit

Public row As Integer
Public col As Integer