Vba 使用宏[Excel][Cristal Report XLS]合并文件后的颜色更改

我正试图制作一个合并文件脚本，就像这个问题一样。

它工作正常，它将文件压缩到同一个新工作簿中的新工作表中

唯一的问题是目标文件中的颜色不相同

以下是比较输入和输出的屏幕截图：

以下是我正在运行以完成任务的宏：

    Option Explicit
'Ref: https://stackoverflow.com/a/26474331/1864883
Private Sub MergeFiles()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String, currentFile As Workbook, thisFile As Workbook, output As Workbook, outputName As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Set thisFile = ActiveWorkbook   'Reference for current workbook

directory = thisFile.Sheets("teste1").Cells(2, 2).Value     'Get path of files to merge from cell B2
outputName = thisFile.Sheets("teste1").Cells(3, 2).Value    'Get output file name from cell B3
fileName = Dir(directory & "*.xl??")



Set output = Workbooks.Add  'Create new workbook for output

'Ref: https://stackoverflow.com/a/4148797/1864883
Do While fileName <> ""
    Set currentFile = Workbooks.Open(directory & fileName)  'Open file as current file
    WrdArray() = Split(fileName, ".")                       'Split file name in `.` to get name without extension
    For Each sheet In currentFile.Worksheets                'Interate each sheet
        currentFile.ActiveSheet.Name = WrdArray(0)          'Changes sheet name to same as file name
        sheetsInOutput = output.Worksheets.Count            'Amount of seets in output
        currentFile.Worksheets(sheet.Name).Copy after:=output.Worksheets(sheetsInOutput)

        GoTo exitFor:

        Next sheet

exitFor:
    currentFile.Close
    fileName = Dir()
Loop

output.Worksheets(1).Delete                                 'Delete first sheet crated when output created
output.SaveAs fileName:=thisFile.Path & "\" & outputName    'Saves output in same directory as this file
output.Close                                                'closes output file
'thisFile.Close

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
'Referência: https://stackoverflow.com/a/2051420/1864883
Private Sub Workbook_Open()
    Call MergeFiles        ' Call your macro
    'ActiveWorkbook.Save    ' Save the current workbook, bypassing the prompt
    'Application.Quit       ' Quit Excel
End Sub

选项显式
'参考：https://stackoverflow.com/a/26474331/1864883
私有子文件（）
Dim目录为字符串，文件名为字符串，工作表为工作表，总计为整数
Dim WrdArray（）作为字符串，currentFile作为工作簿，thisFile作为工作簿，output作为工作簿，outputName作为字符串
Application.ScreenUpdating=False
Application.DisplayAlerts=False
为当前工作簿设置thisFile=ActiveWorkbook的引用
directory=thisFile.Sheets（“teste1”）.Cells（2，2）.Value“获取要从单元格B2合并的文件的路径”
outputName=thisFile.Sheets（“teste1”）.Cells（3，2）.Value'从单元格B3获取输出文件名
fileName=Dir（目录&“*.xl？？”）
设置输出=工作簿。添加“为输出创建新工作簿”
'参考：https://stackoverflow.com/a/4148797/1864883
文件名“”时执行此操作
设置currentFile=Workbooks.Open（目录和文件名）'将文件作为当前文件打开
WrdArray（）=Split（fileName，“.”将文件名拆分为“.”，以获取不带扩展名的名称
对于currentFile.Worksheets中的每张工作表，请交互每张工作表
currentFile.ActiveSheet.Name=WrdArray（0）将工作表名称更改为与文件名相同
sheetsInOutput=output.Worksheets.Count“输出中的seets数量
currentFile.Worksheets（sheet.Name）.Copy after:=输出.Worksheets（sheetsInOutput）
转到出口：
下一页
出口：
当前文件。关闭
fileName=Dir（）
环
输出。工作表（1）。删除“创建输出时删除第一张装箱的工作表”
output.SaveAs fileName:=thisFile.Path&“\”&outputName”将输出保存在与此文件相同的目录中
“output.Close”关闭输出文件
'thisFile.Close
Application.ScreenUpdating=True
Application.DisplayAlerts=True
端接头
“参考：https://stackoverflow.com/a/2051420/1864883
私有子工作簿_Open（）
调用MergeFiles调用宏
“ActiveWorkbook.Save”跳过提示保存当前工作簿
“Application.Quit”退出Excel
端接头

PS：我用其他一些工作正常的文件进行了测试，这些我遇到麻烦的文件来自Crystal Report。

阅读以下内容：

您需要确保两个工作簿的颜色相同

例如：

ThisWorkbook.Colors = Workbooks(2).Colors

请阅读以下内容：

您需要确保两个工作簿的颜色相同

例如：

ThisWorkbook.Colors = Workbooks(2).Colors

---

很好。我将

output.Colors=currentFile.Colors添加到
exitFor:
的第一行中。我知道每一个文件都会重复这个过程，但得到与文件相同的配色方案对我来说很有效。效果很好。我将
output.Colors=currentFile.Colors添加到
exitFor:
的第一行中。我知道每一个文件都会重复这个过程，但是获得与文件相同的配色方案对我来说很有用。