CODEWITHSUNDEEP
vbaexcel
Bluesector
Bluesector

Reputation: 329

Copy Excel theme color in a new workbook

I want to make a macro that copies two sheets in a new workbook. But the theme color in the new created workbook is different.

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

This line does not work for me:

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

I think it has something to do with Set Wb4 = ThisWorkbook Need help...

Greetings

enter image description here

Upvotes: 1

Views: 7118

Answers (3)

JCKE
JCKE

Reputation: 394

An alternative way to transfer the theme would be to save the source theme as a temp xml and load that file into the destination theme.

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

Upvotes: 1

DavB.cs
DavB.cs

Reputation: 589

This appears to be working for me, to copy a workbook theme:

    '   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

Upvotes: 3

Dave
Dave

Reputation: 4356

The Worksheet.Copy only takes the values, but if you set the script to copy the range of cells from one sheet to another, you can use PasteSpecial to copy both the values and the formats - example from this post

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

Upvotes: 0

Related Questions