Сохранение цвета с VBA, когда копировать листы в новую книгу

Question

У меня есть код

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 

но цвета в новой книге это отличается от оригинальной книги

Как сохранить цветы?

Answer 1

Я не уверен, какой цвет вы упоминаете, но попытаться изменить ThemeColorScheme со следующим кодом:

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

Вы должны изменить путь к папке с Excel и изменить тему на один вам нужно. Список тем, которые вы можете найти в макете страницы -> Цвета. Возможно, вам придется изменить «Документные темы 15» на «Документные темы 14» для MS Excel 2010.

Или вы можете записать макрос с меняющейся темой в макете страницы -> Цвета, он автоматически сгенерирует код.

Answer 2

Хотя получение пути к файлу цветовой схемы является хорошим решением, оно может не работать, если вы не собираетесь работать с электронной таблицей - у другого человека может не быть доступа к конкретному файлу цветовой схемы. В качестве альтернативы вы можете запустить суб, как показано ниже, что является черновиком, чтобы заменить цвета темы (которые изменяются с темой) на фактический цвет.

Эта подпрограмма будет работать над выбранным диапазоном и «навести» цвета внутренних элементов, границ, шрифтов и т. Д., А также другие изменяющиеся темы. Это далеко не идеально (изменение цветов границы таким образом, например, создаст черную границу, если их нет), но это может быть хорошей отправной точкой для более подробного кода.

Счастливое кодирование!

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