使用macros合并文件后的颜色更改

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

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

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

以下是比较input和输出的截图:

在这里输入图像说明

这里是我正在运行的macros来完成任务:

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:我testing了一些其他文件工作得很好,这些文件,我得到麻烦来自Crystal Report。

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

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

例:

 ThisWorkbook.Colors = Workbooks(2).Colors