VBA powerpoint - code to change table's cell shading - vba

Question

I have a PowerPoint 2010 presentation with a table on one slide.
I want to create a VBA modeless form that will work like a pallete of
formats/colors for formatting cells of that table.
Basically, the buttons on the form would just simulate clicking
specific Shading color in Table Tools/Design menu.
example:
I place the cursor to the cell then click on a button in activated modeless form. The shading of that cell will change according to the color in the code.
The reason I want to do this is that some other people will use it and the colors must be easily accessible (format painter doesn't not seem to copy the shading)
But I cannot find a way to make this VBA. I have tried recording macro in Word (not possible in PP) with no success.

Answer 1

Try this... (Not polished code, but should give you what you need(ed))
Public sub TblCellColorFill()
Dim X As Integer
Dim Y As Integer
Dim oTbl as Table
set oTbl = ActiveWindow.Selection.Shaperange(1).Table 'Only works is a single table shape is selected - add some checks in your final code!
For X = 1 To otbl.Columns.Count
For Y = 1 To otbl.Rows.Count
With otbl.Cell(Y, X)
If .Selected <> False Then 'Strange bug - will ignore if statement entirely if you use "= True"
'Debug.Print "Test worked " & Now
'We have the shape we need
.shape.Fill.ForeColor.RGB = RGB(100, 150, 200) 'Add your color here
End If
End With
Next 'y
Next 'x
End Sub

Answer 2

For table styling in MSPowerPoint 2013 I use
Sub STYLE_TABLE_2()
' Change table style
' Two rows Dark Gray and White Font
' Next odd rows Light Gray/ even Moderate Gray/ and Black Font
Dim iCols As Integer
Dim iRows As Integer
Dim oTbl As Table
' Debug.Print (ActiveWindow.Selection.ShapeRange(1).Type)
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then ' Shape is selected ppSelectionShapes=2 ppSelectionSlides=3 ppSelectionNone=0
If .ShapeRange(1).Type = msoTable Then ' If first shape Type=19 is msoTable
' (--- note not all table-looking shapes are Table style Can be Type=14 msoPlaceholder
Debug.Print ("We are certain inside table") '
Set oTbl = ActiveWindow.Selection.ShapeRange(1).Table 'Only works if single table or its part is selected
For iCols = 1 To oTbl.Columns.Count
For iRows = 1 To oTbl.Rows.Count
With oTbl.Cell(iRows, iCols)
.Shape.TextFrame.TextRange.Font.Name = "Arial"
.Shape.TextFrame.TextRange.Font.Size = 12
If iRows Mod 2 <> 0 Then ' Odd numbers
Debug.Print ("Ymod2 2") '
.Shape.Fill.ForeColor.RGB = RGB(236, 234, 241)
Else
.Shape.Fill.ForeColor.RGB = RGB(215, 210, 225)
End If
If (.Selected <> False) And (iRows < 3) Then 'Cannot be "= True"
.Shape.Fill.ForeColor.RGB = RGB(166, 166, 166)
.Shape.TextFrame.TextRange.Font.Name = "Arial"
.Shape.TextFrame.TextRange.Font.Color = RGB(255, 255, 255)
.Shape.TextFrame.TextRange.Font.Size = 12
End If
End With
Next 'iRows
Next 'iCols
End If
End If
End With
End Sub