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

【问题标题】：Chart colors change when copying worksheet to a new workbook将工作表复制到新工作簿时图表颜色发生变化
【发布时间】：2015-03-16 19:14:51
【问题描述】：

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

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

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

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

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

【问题讨论】：

颜色是如何定义的？我怀疑XLMaster 中的调色板与XLClinic 中的不同。
我很确定 XLMaster 中的颜色不是从调色板中选择的，而是根据进行格式化的人的个人喜好选择的。我可以从这些颜色选择中创建一个调色板并将其复制到 XLClinic 吗？
是的。示例：假设图表上的一条线是红色的。在包含XLClinic 的工作簿中，您可以使用Workbooks("yourbook.xls").Colors(0) = vbRed 将调色板索引0 设置为红色。然后在您的代码中将该行的颜色索引设置为 0。这将保持工作簿之间的颜色一致性
这是否意味着如果我想要红色，我需要手动编辑每个图表以使用调色板 (0)，然后手动（通过 VBA）将这些调色板设置复制到新工作簿？
我要做的是遍历图表中的颜色，获取颜色索引和相应的颜色（例如RGB，vbConstant），然后使用它来更新目标调色板。这样就不需要手动操作了。

标签： vba excel excel-2010

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

【讨论】：

我错过了什么吗？您在For...Next 循环中的代码实际上是x = x。
第一次应用颜色时，它不是作为 RGB 应用的，而是作为主题颜色和亮度级别应用的。但是我可以读取主题/亮度应用颜色的 RGB（在等号的右侧）并将这种颜色重新应用为 RGB，而不是主题/亮度，到我刚刚从中读取它的同一系列（在左侧）。
告诉你这很混乱。
谢谢，花了将近一个月的时间才明白这一点，但最终还是成功了。您的解决方案似乎没有完成这项工作，因为颜色在它们出现在目标表上时已经很糟糕了，但它确实引导我找到了我想出的解决方案。
也许您应该在将图表移动到另一张表之前应用我的代码 sn-p。

【解决方案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

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

【讨论】：