将多个工作簿合并为一个后，颜色格式丢失答案

【问题标题】：Color formatting is lost after merging multiple workbooks into one将多个工作簿合并为一个后，颜色格式丢失
【发布时间】：2019-06-26 03:35:38
【问题描述】：

我有几个不同结构的 SSRS 报告（.xls 文件）：

报表 1 内有 3 张 Excel 表格。
报表 2 里面有 2 张 Excel 表格。
报表 3 里面有 4 张 Excel 表格。

我希望将所有这 9 个 excel 工作表合并到具有不同工作表的单个 Excel 文件中，也就是说，我的最终 excel 文件应该包含所有这 9 个工作表，我可以使用下面的宏代码来实现。

Path = "C:\Users\FILES\" ' This will fetch all the files form the mentioned location
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
    For Each Sheet In ActiveWorkbook.Sheets
        Sheet.Copy After:=ThisWorkbook.Sheets(1)
    Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
Loop

Application.DisplayAlerts = False ' Delete an extra sheet
Worksheets("SHEET1").Delete
Application.DisplayAlerts = True

Application.DisplayAlerts = False ' This will create a new excel file and stores all the data in to it.
ThisWorkbook.CheckCompatibility = False
ThisWorkbook.SaveAs Filename:="C:\Users\merge.xls", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True

Application.DisplayAlerts = False ' Save and exit
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.Quit

我面临的唯一问题是合并文件时我的 VBA 代码不包括应用于我的 SSRS 报告中的几个单元格的颜色。

如何在不丢失已应用的颜色格式的情况下复制 excel 文件？

【问题讨论】：

这些单元格是如何着色的？条件格式还是直接更改单元格？新文件是 openXML 类型吗？ (.xlsm, .xlsx)
Filename:="C:\Users\merge.xls", FileFormat:=xlOpenXMLWorkbook, 不匹配，应该是 .xlsx 文件
我什至尝试从.xls 更改为.xlsx，还是一样。
源文件由SSRS生成，着色在.RDL文件中完成

标签： excel vba ssrs-2012

【解决方案1】：

使用.Copy 和.PasteSpecial，通常应该避免使用，但在这种情况下，它们似乎是唯一的解决方案...

原因：
出现此问题的原因是 SQL Server Reporting Services 2008 和 SQL Server Reporting Services 2008 R2 都使用自定义的调色板，而不是 Excel 附带的内置调色板。报告中使用的前 56 种唯一颜色在自定义调色板中定义。

解决方法：
您可以使用以下方法之一解决此问题，具体取决于您在环境中使用的 Excel 版本：

Excel 2007 或 Excel 2010：使用以下方法之一：

方法一：使用Ctrl+C和Ctrl+V组合，步骤如下：

在源工作簿中按 Ctrl+C 复制源数据。在新工作簿中，使用以下方法之一来保留源格式：右键单击并从“编辑”菜单中选择“选择性粘贴”选项，然后通过选择“使用所有源主题”选项粘贴数据。或者在新工作表中按 Ctrl+V 后，在粘贴选项中选择保留源格式。

使用此方法时需要注意的一个警告是，行高和列宽可能不会延续到新工作簿。要保持行高和列宽，您可以先将工作表移动或复制到新工作簿以确保列宽和行高可以接受，然后再次使用源格式复制内容。

方法 2：通过以下附加步骤使用移动或复制工作表操作：

在执行移动或复制工作表以将工作表复制到另一个工作簿后，请执行以下操作：转到文件菜单并在左窗格中选择选项。在 Excel 选项页面中，选择保存选项。单击“保留工作簿的视觉外观”下的“颜色...”按钮。在“颜色”页面的“复制颜色自”列表框中，选择从 SQL Server Reporting Services 导出的源 Excel 文件。单击确定两次关闭所有选项窗口。

您还可以使用类似于以下内容的宏代码自动执行此解决方法：
Sub Sample() 
    Sheets("OriginalExcelSheetExportedFromReport").Select 
    Sheets("OriginalExcelSheetExportedFromReport ").Copy 
    ActiveWorkbook.Colors = Workbooks("OriginalExcelSheetExportedFromReport.xls").Colors 
End Sub
Excel 2003：通过以下附加步骤使用移动或复制工作表操作：

在执行移动或复制工作表以将工作表复制到另一个工作簿后，请执行以下操作：转到工具菜单，然后单击选项。选择颜色选项卡，然后在从列表框中复制颜色，选择从 SQL Server Reporting Services 导出的源 Excel 文件。单击“确定”关闭对话框。

来源：Microsoft Support 2465477
类似问题：https://stackoverflow.com/a/6447743/10223558

当我们这样做时，您可以尝试下面的代码以避免ActiveWorkbook

Do While Filename <> ""
    With Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
        For Each Sheet In .Sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        Next Sheet
        .Close
    End With
    Filename = Dir()
Loop

【讨论】：

【解决方案2】：

我发现了问题，对代码进行了更改，添加了一行将颜色从源文件复制到新文件而不做任何更改。

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)  

***ActiveWorkbook.Colors = Workbooks(Filename).Colors***

【讨论】：