根据字体颜色更改单元格填充颜色

时间:2015-11-06 20:40:44

标签: excel vba charts powerpoint powerpoint-vba

我需要将有条件格式的数据从Excel 2013移动到PowerPoint 2013中的预先存在的表中。字体颜色和格式将从Excel传送到PowerPoint,但需要手动添加单元格填充。

是否可以在PowerPoint中创建一个宏来搜索每个表格的单元格,找到五种特定字体颜色中的一种“(xxx,xxx,xxx)”,然后用指定颜色填充该单元格?

我在Excel中的表格具有条件格式颜色,并具有以下规则:

  • “深绿色”
    填写:(146,208,80) 字体颜色:(79,98,40)

  • “浅绿色”
    填写:(195,214,155) 字体颜色:(80,98,40)

  • “灰”
    填写:(242,242,242) 字体颜色:(166,166,166)

  • “淡粉色”
    填写:(230,185,184) 字体颜色:(150,55,53)

  • “深粉色”
    填写:(217,150,148) 字体颜色:(149,55,53)

我可以通过创建一个新图表来获得单元格字体并填充剩余的一种方法,但是当它需要完成近一百次时会变得乏味。

理想情况下,我希望宏搜索一个演示文稿,如果它找到一个表格单元格值的字体为(深绿色)(79,98,40),请将该单元格填充到(149,208,80)。然后继续搜索接下来的四种颜色。

1 个答案:

答案 0 :(得分:0)

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