Изменить цвет заполнения ячейки на основе цвета шрифта

Question

Мне нужно переместить условно отформатированные данные из Excel 2013 в ранее существующие таблицы в PowerPoint 2013. Цвет шрифта и форматирование будут перенесены из Excel в PowerPoint, но заполнение ячейки должно быть вручную добавлено.

Возможно ли создать макрос в PowerPoint, который будет искать в ячейке каждой таблицы, найти один из пяти конкретных цветов шрифта «(xxx, xxx, xxx)», а затем заполнить эту ячейку указанным цветом?

У меня есть таблицы в Excel, которые имеют условные цвета форматирования со следующими правилами:

• "Dark Green"
  Заливка: (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)

Один способ, которым я могу получить шрифт ячейки и fi чтобы остаться, создав новую диаграмму, но это утомительно, когда нужно сделать это почти сто раз.

В идеале я хотел бы, чтобы макрос просматривал презентацию, если он находит шрифт ячейки таблицы как (Темно-зеленый) (79, 98, 40), заполните эту ячейку (149, 208, 80). Затем продолжите поиск следующих четырех цветов.

Answer 1

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