Change Themes colours when I open workbook

[oberti]

Hello,

I wanted to know if it´s possible to change the theme color every time I open an excel workbook with vba.

Every time I open my workbook I would like to randomly switch between the available color themes

Thanks in advance.

 

[oberti]

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Change Themes colours when I open workbook
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[Domenic]

First, place the following code in a regular module (Visual Basic Editor ~ Insert ~ Module)...

Sub setThemeColorScheme()

    Dim themeColorSchemeFolder As String
    Dim themeColorSchemeFile As String
 
    themeColorSchemeFolder = "C:\Program Files (x86)\Microsoft Office\root\Document Themes 16\Theme Colors\" 'change the path accordingly
 
    If Right$(themeColorSchemeFolder, 1) <> "\" Then
        themeColorSchemeFolder = themeColorSchemeFolder & "\"
    End If
 
    themeColorSchemeFile = getRandomThemeColorScheme(themeColorSchemeFolder)
 
    If Len(themeColorSchemeFile) > 0 Then
        ThisWorkbook.Theme.themeColorScheme.Load themeColorSchemeFolder & themeColorSchemeFile
    End If
 
End Sub

Private Function getRandomThemeColorScheme(ByVal themeColorSchemeFolder As String) As String

    Dim arrThemeColorFileNames() As String
    Dim currentFileName As String
    Dim fileCount As Long
    Dim fileIndex As Long
 
    If Right$(themeColorSchemeFolder, 1) <> "\" Then
        themeColorSchemeFolder = themeColorSchemeFolder & "\"
    End If
 
    currentFileName = Dir(themeColorSchemeFolder & "*.xml", vbNormal)
 
    If Len(currentFileName) = 0 Then
        getRandomThemeColorScheme = vbNullString
        Exit Function
    End If
 
    ReDim arrThemeColorFileNames(1 To 50)
 
    fileCount = 0
    Do
        fileCount = fileCount + 1
        arrThemeColorFileNames(fileCount) = currentFileName
        If fileCount Mod 50 = 0 Then
            ReDim Preserve arrThemeColorFileNames(1 To (fileCount + 50))
        End If
        currentFileName = Dir
    Loop While (Len(currentFileName) > 0)
 
    ReDim Preserve arrThemeColorFileNames(1 To fileCount)
 
    Randomize
    fileIndex = Int((fileCount * Rnd) + 1)
 
    getRandomThemeColorScheme = arrThemeColorFileNames(fileIndex)
 
End Function

Then place the following code in the module for ThisWorkbook (right-click ThisWorkbook in the Project Explorer Window for your workbook)...

Private Sub Workbook_Open()
    setThemeColorScheme
End Sub

Now save, close, and re-open your workbook. A random theme color should automatically be chosen for your workbook.

Hope this helps!

 

[oberti]

First, place the following code in a regular module (Visual Basic Editor ~ Insert ~ Module)...

Sub setThemeColorScheme()

    Dim themeColorSchemeFolder As String
    Dim themeColorSchemeFile As String
 
    themeColorSchemeFolder = "C:\Program Files (x86)\Microsoft Office\root\Document Themes 16\Theme Colors\" 'change the path accordingly
 
    If Right$(themeColorSchemeFolder, 1) <> "\" Then
        themeColorSchemeFolder = themeColorSchemeFolder & "\"
    End If
 
    themeColorSchemeFile = getRandomThemeColorScheme(themeColorSchemeFolder)
 
    If Len(themeColorSchemeFile) > 0 Then
        ThisWorkbook.Theme.themeColorScheme.Load themeColorSchemeFolder & themeColorSchemeFile
    End If
 
End Sub

Private Function getRandomThemeColorScheme(ByVal themeColorSchemeFolder As String) As String

    Dim arrThemeColorFileNames() As String
    Dim currentFileName As String
    Dim fileCount As Long
    Dim fileIndex As Long
 
    If Right$(themeColorSchemeFolder, 1) <> "\" Then
        themeColorSchemeFolder = themeColorSchemeFolder & "\"
    End If
 
    currentFileName = Dir(themeColorSchemeFolder & "*.xml", vbNormal)
 
    If Len(currentFileName) = 0 Then
        getRandomThemeColorScheme = vbNullString
        Exit Function
    End If
 
    ReDim arrThemeColorFileNames(1 To 50)
 
    fileCount = 0
    Do
        fileCount = fileCount + 1
        arrThemeColorFileNames(fileCount) = currentFileName
        If fileCount Mod 50 = 0 Then
            ReDim Preserve arrThemeColorFileNames(1 To (fileCount + 50))
        End If
        currentFileName = Dir
    Loop While (Len(currentFileName) > 0)
 
    ReDim Preserve arrThemeColorFileNames(1 To fileCount)
 
    Randomize
    fileIndex = Int((fileCount * Rnd) + 1)
 
    getRandomThemeColorScheme = arrThemeColorFileNames(fileIndex)
 
End Function

Then place the following code in the module for ThisWorkbook (right-click ThisWorkbook in the Project Explorer Window for your workbook)...

Private Sub Workbook_Open()
    setThemeColorScheme
End Sub

Now save, close, and re-open your workbook. A random theme color should automatically be chosen for your workbook.

Hope this helps!

Fantastic , it' working

THANKS

 

[Domenic]

You're very welcome, cheers!