Preserve colors from vba when copy sheets to new workbook

问题

I have a code

Sub createPrice()
Set ThisWork = ThisWorkbook
strExt = ThisWork.Sheets("Main").Cells(1, 4).Value & "_" & Format(Now, "yyyy_mm_dd_hhmmss")
strSaveName = ThisWork.Path & "\" & strExt & ".xlsx"

ThisWork.Sheets(Array("Main", "Translations")).Copy
With ActiveWorkbook
    .Sheets("Translations").Visible = False
    .Colors = ThisWork.Colors
    .SaveAs strSaveName, FileFormat:=51
    .Close SaveChanges:=True
End With
End Sub

But Colors in new workbook is differs from original workbook

How to preserve colors?

回答1:

I am not sure what color you are mentioning but try to change ThemeColorScheme with the following code:

ActiveWorkbook.Theme.ThemeColorScheme.Load ("C:\Program Files (x86)\Microsoft Office\Document Themes 15\Theme Colors\Office 2007 - 2010.xml")

You should change the path to your folder with Excel and change the Theme to one you need. List of themes you can find in Page Layout -> Colors. And you may need to change 'Document Themes 15' to 'Document Themes 14' for MS Excel 2010.

Or you can record the macro with changing theme in Page Layout -> Colors, it will generate code automatically.

回答2:

Though getting the path to the Color Scheme file is a good solution, it may not work if you're not going to be the one operating the spreadsheet - the other person may not have access to the specific color scheme file. Alternatively, you can run a sub like the one below, which is a rough draft, to replace theme colors (which change with theme) by the actual color.

This sub will run over a selected range and "pin" the colors of its cells' interiors, borders, fonts etc., along with other theme-varying properties. It's far from perfect (changing border colors in this way, for instance, will create a black border if there are none), but it may be a good starting point for more detailed code.

Happy coding!

Sub FixColors()

Dim rng As Range

For Each rng In Selection

    With rng.Interior
        .Color = .Color
    End With
    With rng.Borders
        .Color = .Color
    End With
    With rng.Interior
        .PatternColor = .PatternColor
    End With
    With rng.Font
        .Color = .Color
        .Name = .Name
        .Size = .Size
    End With

Next

End Sub

来源：https://stackoverflow.com/questions/34218182/preserve-colors-from-vba-when-copy-sheets-to-new-workbook

标签

excel

vba

excel-vba