在新工作簿中复制Excel主题颜色

Question

我想制作一个在新工作簿中复制两张纸的宏。 但是新创建的工作簿中的主题颜色是不同的。

Sub Export_File()
Dim Wb3 As Workbook
Dim strSaveName As String

strSaveName = Worksheets("Communication").Range("a2").Value
Set Wb3 = ThisWorkbook

'copy sheets to new workbook
Sheets(Array("Auswertung", "Communication")).Copy
ActiveWorkbook.SaveAs strSaveName

Workbooks(Wb3).Colors = Workbooks(strSaveName).Colors

End Sub

此行对我不起作用：

Workbooks(Wb4).Colors = Workbooks(strSaveName).Colors

我认为它与Set Wb4 = ThisWorkbook 有关...需要帮助......

问候

Answer 1

这似乎对我有用，可以复制工作簿主题：

    '   copy the colors and themes
    '
    resultWorkbook.Colors = sourceWorkbook.Colors
    'Theme is not the same as colors
    Dim sourceTheme As Microsoft.Office.Core.ThemeColorScheme = sourceWorkbook.Theme.ThemeColorScheme 
    Dim resultTheme As Microsoft.Office.Core.ThemeColorScheme = resultWorkbook.Theme.ThemeColorScheme 

    For i = 1 To sourceTheme.Count  ' there are 12 theme colors: https://msdn.microsoft.com/en-us/library/aa432704(v=office.12).aspx
        'Debug.WriteLine(String.Format("{0, -2} ~ {1}", i, sourceTheme.Colors(i).RGB))
        resultTheme.Colors(i).RGB = sourceTheme.Colors(i).RGB
    Next i

Answer 2

Worksheet.Copy仅获取值，但如果您设置脚本以将单元格范围从一个工作表复制到另一个工作表，则可以使用PasteSpecial复制值和格式 - 示例来自this post

Worksheets(1).Cells(i, 3).Copy
Worksheets(2).Cells(a, 15).PasteSpecial Paste:=xlPasteFormats
Worksheets(2).Cells(a, 15).PasteSpecial Paste:=xlPasteValues

Answer 3

传输主题的另一种方法是将源主题另存为临时xml，然后将该文件加载到目标主题中。

DestWB.Colors = SourceWB.Colors
Dim TempThemeFile As String
Dim sourceTheme As Microsoft.Office.Core.ThemeColorScheme
set sourceTheme = sourceWorkbook.Theme.ThemeColorScheme 

'Late binding alternative:
'Dim sourceTheme As Object
'Set sourceTheme = SourceWB.Theme.ThemeColorScheme

TempThemeFile = Environ$("temp") & "\xltheme" & Format(Now, "dd-mm-yy h-mm-ss") & ".xml"
sourceTheme.Save TempThemeFile
DestWB.Theme.ThemeColorScheme.Load TempThemeFile
Kill TempThemeFile