VBA powerpoint - 更改表格单元格阴影的代码

VBA powerpoint - code to change table's cell shading

提问by user2523971

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.

我有一个 PowerPoint 2010 演示文稿，一张幻灯片上有一张表格。我想创建一个 VBA 无模式表单，它将像用于格式化该表的单元格的格式/颜色调色板一样工作。基本上，表单上的按钮只会模拟点击表格工具/设计菜单中的特定底纹颜色。

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.

但是我找不到制作这个 VBA 的方法。我曾尝试在 Word 中录制宏（在 PP 中不可能），但没有成功。

回答by GreatSheikhs

Try this... (Not polished code, but should give you what you need(ed))

试试这个......（不是优美的代码，但应该给你你需要的东西（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

回答by Bomba Ps

For table styling in MSPowerPoint 2013 I use

对于 MSPowerPoint 2013 中的表格样式，我使用

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