将工作表复制到新工作簿时图表颜色发生变化

Question

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

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

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

如果我通过打开 XLMaster 复制工作表 'manually'，它们也会改变，右键单击工作表名称并选择 Move/Copy。

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

Answer 1

这似乎是一个困扰整个互联网的问题。我最终编写了一个例程来将所有系列颜色从源复制到目标：

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

不完全理想，但它有效。我确实意识到这依赖于以相同的顺序找到源图表和目标图表才能正确应用颜色。到目前为止，在有限的测试中，它工作正常。如果我发现工作表中的图表在复制后最终以不同的顺序排列，我将不得不更新。

Answer 2

在复制之前将颜色重新应用到图表会容易得多，并且您不需要通过 RGB 算法来回进行。 Select 图表和运行这个：

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 中引入的完全混乱的颜色主题系统的链接。以上内容适用于使用填充格式的条形图、柱形图和面积图。折线图和散点图使用线条以及标记背景和前景色。

将工作表复制到新工作簿时图表颜色发生变化

Chart colors change when copying worksheet to a new workbook

vba

excel

excel-2010