根据字体颜色更改单元格填充颜色 [英] Change cell fill color based on font color

问题描述

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

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.

是否可以在PowerPoint中创建一个宏，该宏将搜索每个表的单元格，找到五种特定字体颜色（xxx，xxx，xxx）之一，然后用指定的颜色填充该单元格？

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?

我在Excel中有一些表，这些表具有以下规则的条件格式颜色：

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

• 深绿色
  
  填充：（146，208，80）
  字体颜色：（79，98，40）

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

浅绿色

填充：（195，214，155）
字体颜色：（80，98，40）

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

灰色

填充：（242，242，242）
字体颜色：（166，166，166）

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

浅粉红色

填充：（230，185，184）
字体颜色：（150，55，53）

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

深粉红色

填充：（217、150、148）
字体颜色：（149、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.

理想情况下，如果宏发现表单元格值的字体为（深绿色），我希望宏可以通过演示文稿进行搜索（79 ，98、40），然后将该单元格填充到（149、208、80）。然后继续搜索接下来的四种颜色。

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.

推荐答案

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

这篇关于根据字体颜色更改单元格填充颜色的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！