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

时间:2014-12-02 16:44:01

标签: vba format cell powerpoint powerpoint-vba

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

示例:

我将光标放在单元格上,然后单击激活的无模式窗体中的按钮。该单元格的阴影将根据代码中的颜色而改变。

我想这样做的原因是其他人会使用它并且颜色必须易于访问(格式画家似乎不能复制阴影)

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

2 个答案:

答案 0 :(得分:1)

试试这个......(没有抛光的代码,但应该给你所需要的东西(编辑))

    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

答案 1 :(得分:0)

我使用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