【VBA】Powerpoint 表格每行交替填充颜色

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

Sub 交替填充表格行背景色()

Dim sh As Integer
Dim i As Integer
Dim j As Integer
Dim x As Integer
x = 1
'分别确定标题行色、奇数行颜色和偶数行颜色
biaoti = RGB(217, 217, 217)
jishu = RGB(0, 0, 0)
oushu = RGB(12, 17, 127)

        With ActivePresentation.Slides(1)
            For sh = 1 To .Shapes.Count
                If .Shapes(sh).HasTable Then

                    With ActivePresentation.Slides(1).Shapes(sh).Table
                        '确定表格行列数
                        iCol = .Columns.Count
                        iRow = .Rows.Count

                        '令第一个单元格的填充色为标题色
                        With .Cell(1, 1)
                            .Shape.Fill.ForeColor.RGB = biaoti
                        End With

                        '填充标题行颜色，判断下一行第一个单元格的填充颜色是否与标题填充色一致，如一致换到下一行
                        While .Cell(x, 1).Shape.Fill.ForeColor.RGB = biaoti
                            For m = 1 To iCol
                                .Cell(x, m).Shape.Fill.ForeColor.RGB = biaoti
                            Next
                            x = x + 1
                        Wend
                        '对标题行之外的表格范围，按行交替填充单元格颜色
                                For i = x To iCol
                                    If (i - x + 1) Mod 2 = 1 Then
                                            tianchong = jishu
                                        Else
                                            tianchong = oushu
                                    End If
                                    '开始填充当前行单元格
                                    For j = 1 To iRow
                                        Set oCell = .Cell(i, j)
                                        With oCell
                                            .Shape.Fill.ForeColor.RGB = tianchong
                                        End With
                                    Next j
                                    '当前行填充完毕
                                Next i
                    End With

                End If
            Next
        End With
End Sub

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：powerpoint Point Power VBA int

谢谢分享,学习下

phipe 发表于 2019-1-27 00:16
谢谢分享,学习下

感谢回复，这个论坛好像没有地方发类帖子哟，所以就发到这里了。

sansha3480 发表于 2019-1-27 01:36
感谢回复，这个论坛好像没有地方发类帖子哟，所以就发到这里了。

有的,有个Excel专版,可以转那边过去: https://bbs.pinggu.org/forum-136-1.html

phipe 发表于 2019-1-27 10:28
有的,有个Excel专版,可以转那边过去: https://bbs.pinggu.org/forum-136-1.html

感谢！