マクロを使用してファイルをマージした後のカラー変更[Excel] [Cristal 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