时间戳

首页 > 解决方案 > 是否可以根据相同的图表标题排列图表 - 同一行的图表标题

excel - 是否可以根据相同的图表标题排列图表 - 同一行的图表标题

问题描述

我在工作表中有许多图表，我想按顺序排列。我得到了连续排列 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

在此处输入图像描述 如何修改代码以使具有相同标题的图表位于同一行，如上图。

标签： excelvba

解决方案

真正的编码取决于确切的要求。我做了一个简单的例子，按标题排列所有图表。它有一些限制（例如它不进行排序）并将所有具有相同标题的图表放在同一行上。

该代码使用以图表标题作为键、逻辑位置（包含行和列）和值的字典。

它遍历所有图表，获取标题并检查标题是否已经在字典中。如果是，则获取上一个具有相同标题的图表的位置，并将逻辑列增加 1。如果不是，则将新的逻辑行添加到字典中（行 = 字典大小，col = 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. 所有你需要的（当然你可以用setter和getter包装它......）

Option Explicit

Public row As Integer
Public col As Integer

推荐阅读