Search code examples
vbapowerpoint

Set the theme header font for text in a shape


I develop a VBA add-in for PowerPoint which can insert a table into a slide. I set the font family for the table's header cells to the ones defined in the theme fonts. I want it to change when I switch to another theme font.

However, if I use the following code the font will be "pinned" to the font family name of the theme's major font and does not change when I change the theme fonts.

Sub FormatTable(table As table)
    Dim headerFont As ThemeFont
    Set headerFont = ActivePresentation.SlideMaster.Theme.ThemeFontScheme.MajorFont(1)
    For Each c In table.Rows(1).Cells
        c.shape.TextFrame.TextRange.Font.Name = headerFont.Name
    Next c
End Sub

How do I have to rewrite the code to keep the font exchangeable via theme changes?


Solution

  • ' Theme fonts have special names
    'Body font, Latin (ie main) +mn-lt
    'Heading Font, Latin + mj - lt
    'Body Font, Eastern + mn - ea
    'Heading Font, Eastern + mj - ea
    'Body font, complex scripts +mn-cs
    'Heading font, complex scripts  +mn-cs
    
    Sub FormatTable(table As table)
        Dim headerFont As ThemeFont
        Dim c As Cell
        Set headerFont = ActivePresentation.SlideMaster.Theme.ThemeFontScheme.MajorFont(1)
        For Each c In table.Rows(1).Cells
            ' This sets the font to whatever the NAME of the theme font is
            ' c.Shape.TextFrame.TextRange.Font.Name = headerFont.Name
            ' This sets it to the actual theme font:
            c.Shape.TextFrame.TextRange.Font.Name = "+mn-lt"
            ' And after running the code, you'll see that the font
            ' is set to e.g. Calibri (Body) rather than just Calibri
        Next c
    End Sub