使用宏 [Excel] [Crystal Report XLS] 合并文件后颜色变化

Question

我正在尝试制作一个合并文件脚本，就像这个问题一样。 https://stackoverflow.com/a/4148797/1864883

它工作正常，它将文件复制到同一个新工作簿中的新工作表中。

唯一的问题是目标文件中的颜色不一样。

下面是输入输出对比截图：

这是我为完成任务而运行的宏：

    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

PS：我测试了其他一些运行良好的文件，我遇到问题的这些文件来自 Crystal Report。

Answer 1

阅读：https://msdn.microsoft.com/en-us/library/office/ff821660.aspx

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

例子：

ThisWorkbook.Colors = Workbooks(2).Colors