Question

我有一个Excel 2010工作簿，其中包含我们报告中使用的各种图表。我编写了VBA代码，使用以下方法将选定的工作表复制到新工作簿：

XLMaster.Sheets(x).Copy after:=XLClinic.Sheets(XLClinic.Sheets.Count)

然而，当我这样做时，图表中的颜色会发生变化。

如果我通过打开XLMaster“手动”复制工作表，右键单击工作表名称并选择移动/复制，它们也会更改。

复制到XLClinic时如何保持XLMaster中的颜色设置？

Answer 1

在复制之前将颜色重新应用到图表会更容易，并且您不需要通过RGB算法对其进行往返。选择一个图表并运行：

Sub RecolorChartFills
  Dim srs As Series
  For Each srs In ActiveChart.SeriesCollection
     srs.Format.Fill.Forecolor.RGB = srs.Format.Fill.Forecolor.RGB
  Next
End Sub

这保持了相同的颜色，但是从Office 2007中引入的完全混乱的颜色主题系统取消链接。上面的工作在条形图，柱形图和面积图上，它们使用填充格式。线条和散点图使用线条以及标记背景和前景色。

Answer 2

这似乎是一个让整个互联网混乱的问题。我最后写了一个例程来复制从源到目的地的所有系列颜色：

i = 0
j = 0
For Each ChartObj In Master.ChartObjects
  ReDim Preserve Titles(i)
  ReDim Preserve Charts(i)
  Titles(i) = ChartObj.Chart.ChartTitle.Text
  Charts(i) = ChartObj.Chart.Name
  For Each Ser In ChartObj.Chart.SeriesCollection
    ReDim Preserve R(j)
    ReDim Preserve G(j)
    ReDim Preserve B(j)
    R(j) = Ser.Interior.Color Mod 256
    G(j) = Ser.Interior.Color \ 256 Mod 256
    B(j) = Ser.Interior.Color \ 65536 Mod 256
    j = j + 1
  Next
  i = i + 1
Next

j = 0
For Each ChartObj In Clinic.ChartObjects
  For i = LBound(Titles) To UBound(Titles)
    If Titles(i) = ChartObj.Chart.ChartTitle.Text Then
      For Each Ser In ChartObj.Chart.SeriesCollection
        Ser.Interior.Color = RGB(R(j), G(j), B(j))
        j = j + 1
      Next
      i = UBound(Titles) + 1
    End If
  Next
Next

不完全理想，但它确实有效。我确实意识到这依赖于以相同的顺序查找源图和目标图，以便正确应用颜色。到目前为止，在有限的测试中，它运行良好。如果我找到工作表，我必须更新，其中图表在复制后最终会以不同的顺序排列。

将工作表复制到新工作簿时图表颜色会更改

2 个答案: