Change cell fill color based on font color

0
votes

I need to move conditionally formatted data from Excel 2013 into pre-existing tables in PowerPoint 2013. The font colors and formatting will carry from Excel to PowerPoint, but the cell fill needs to be manually added.

Is it possible to create a macro in PowerPoint that will search through each table's cell, find one of five specific font colors "(xxx,xxx,xxx)", then fill that cell with a specified color?

I have tables in Excel that have conditional formatting colors with the following rules:

  • "Dark Green "
    Fill: (146, 208, 80) Font color: (79, 98, 40)

  • "Light Green"
    Fill: (195, 214, 155) Font color: (80, 98, 40)

  • "Grey"
    Fill: (242, 242, 242) Font color: (166, 166, 166)

  • "Light Pink"
    Fill: (230, 185, 184) Font color: (150, 55, 53)

  • "Dark Pink"
    Fill: (217, 150, 148) Font color: (149, 55, 53)

One way I can get the cell font and fill to stay is by creating a new chart, but that gets tedious when it needs to be done nearly a hundred times.

Ideally, I would like the macro to search through a presentation, if it finds a table cell value's font as (Dark green) (79, 98, 40), fill that cell to (149, 208, 80). Then continue searching for the next four colors as well.

1
excelvbachartspowerpoint

1 Answers

0
votes
Option Explicit

Sub Tester()

    Dim s As Slide, p As Presentation, shp As Shape
    Dim rw As Row, cl As Cell

    For Each s In ActivePresentation.Slides
        For Each shp In s.Shapes
            If shp.HasTable Then
                For Each rw In shp.Table.Rows
                For Each cl In rw.Cells
                    ProcessCellColors cl
                Next cl
                Next rw
            End If
        Next shp
    Next s

End Sub

Sub ProcessCellColors(c As Cell)
    Dim tf As TextFrame, clr As Long
    Set tf = c.Shape.TextFrame
    clr = -1
    If tf.HasText Then
        'assumes all text has the same color...
        Select Case tf.TextRange.Font.Color.RGB
            Case vbBlack: clr = vbYellow 'my testing
            Case RGB(79, 98, 40): clr = RGB(146, 208, 80)
            Case RGB(80, 98, 40): clr = RGB(195, 214, 155)
            '....etc etc
        End Select
        If clr <> -1 Then
            c.Shape.Fill.ForeColor.RGB = clr
        End If
    End If
End Sub