Как изменить цвет границы таблицы в PPT VBA

Question

Я пытаюсь изменить цвет границ таблиц на каждом слайде в зависимости от того, является ли граница определенного цвета. Однако я продолжаю получать ошибку времени выполнения 91 - переменная объекта или переменная блока не установлена. Любая идея, где я иду не так?

Dim myTable As Table
Dim sh As Shape
Dim sl As Slide
Dim iRow As Integer
Dim iCol As Integer

For Each sl In ActivePresentation.Slides
    For Each sh In sl.Shapes
        If sh.HasTable Then Set myTable = sh.Table
        For iRow = 1 To myTable.Rows.count
            For iCol = 1 To myTable.Columns.count
                If myTable.Cell(iRow, iCol).Borders(ppBorderTop).ForeColor.RGB = RGB(0, 0, 0) Then myTable.Cell(iRow, iCol).Borders(ppBorderTop).ForeColor.RGB = RGB(100, 0, 0)
                If myTable.Cell(iRow, iCol).Borders(ppBorderBottom).ForeColor.RGB = RGB(0, 0, 0) Then myTable.Cell(iRow, iCol).Borders(ppBorderBottom).ForeColor.RGB = RGB(100, 0, 0)
                If myTable.Cell(iRow, iCol).Borders(ppBorderLeft).ForeColor.RGB = RGB(0, 0, 0) Then myTable.Cell(iRow, iCol).Borders(ppBorderLeft).ForeColor.RGB = RGB(100, 0, 0)
                If myTable.Cell(iRow, iCol).Borders(ppBorderRight).ForeColor.RGB = RGB(0, 0, 0) Then myTable.Cell(iRow, iCol).Borders(ppBorderRight).ForeColor.RGB = RGB(100, 0, 0)
            Next iCol
        Next iRow
    Next sh
Next sl

Answer 1

Поскольку в VBA вы не можете сравнивать RGB напрямую, вам необходимо преобразовать его в число, как показано ниже и не требует пояснений.

Option Explicit

Sub test()
    Dim myTable As Table
    Dim sh As Shape
    Dim sl As Slide
    Dim iRow As Integer
    Dim iCol As Integer

    'set a variable to convert from RGB to Double
    Dim lngvar As Double

    'set the color check
    lngvar = RGB(0, 0, 0)

    Dim o As New Collection
    Set o = getRGB(lngvar)

    'assign the new color
    lngvar = RGB(98, 117, 182)

    Dim c As New Collection
    Set c = getRGB(lngvar)

    For Each sl In ActivePresentation.Slides
        For Each sh In sl.Shapes
            If sh.HasTable Then Set myTable = sh.Table
                For iRow = 1 To myTable.rows.Count
                    For iCol = 1 To myTable.Columns.Count
                        If myTable.cell(iRow, iCol).Borders(ppBorderTop).ForeColor.RGB = RGB(o("R"), o("G"), o("B")) Then myTable.cell(iRow, iCol).Borders(ppBorderTop).ForeColor.RGB = RGB(c("R"), c("G"), c("B"))
                        If myTable.cell(iRow, iCol).Borders(ppBorderBottom).ForeColor.RGB = RGB(o("R"), o("G"), o("B")) Then myTable.cell(iRow, iCol).Borders(ppBorderBottom).ForeColor.RGB = RGB(c("R"), c("G"), c("B"))
                        If myTable.cell(iRow, iCol).Borders(ppBorderLeft).ForeColor.RGB = RGB(o("R"), o("G"), o("B")) Then myTable.cell(iRow, iCol).Borders(ppBorderLeft).ForeColor.RGB = RGB(c("R"), c("G"), c("B"))
                        If myTable.cell(iRow, iCol).Borders(ppBorderRight).ForeColor.RGB = RGB(o("R"), o("G"), o("B")) Then myTable.cell(iRow, iCol).Borders(ppBorderRight).ForeColor.RGB = RGB(c("R"), c("G"), c("B"))
                    Next iCol
                Next iRow
            Next sh
        Exit For
    Next sl
End Sub

Function getRGB(lngCol As Double) As Collection
    Set getRGB = New Collection
    Dim iR As Integer
    Dim iG As Integer
    Dim iB As Integer

    iR = lngCol Mod 256
    iG = (lngCol \ 256) Mod 256
    iB = (lngCol \ 256 \ 256) Mod 256

    Dim item As Variant
    Dim key As String
    key = "R"
    item = iR
    getRGB.Add item, key

    key = "G"
    item = iG
    getRGB.Add item, key

    key = "B"
    item = iB
    getRGB.Add item, key

End Function