修改活动表单元格渐变

Question

我正在尝试调整所选表格中所选单元格的渐变和填充设置。

我已经用 Excel 完成了这项工作。对于 PowerPoint，我管理的最好方法是调整单一填充颜色。我一直在阅读各种网站，但没有任何进展。如何生成下面 Excel 代码中创建的相同效果？

Excel 代码：（工作）

ActiveCell.Select
With Selection.Interior
    .Pattern = xlPatternLinearGradient
    .Gradient.Degree = 90
    .Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
    .Color = 39372
    .TintAndShade = 0
End With

---

*编辑：有点效果，但对颜色仍然不是 100% 满意。

PowerPoint 代码 (WIP)

Dim oSh As Shape
Dim oTbl As Table
Dim lRow As Long ' your i
Dim lCol As Long ' your j
Set oSh = ActiveWindow.Selection.ShapeRange(1)
Set oTbl = oSh.Table

With oTbl
    For lRow = 1 To .Rows.Count
        For lCol = 1 To .Columns.Count
            If .Cell(lRow, lCol).Selected Then
                With .Cell(lRow, lCol).Shape
                    .Fill.TwoColorGradient msoGradientHorizontal, 1
                    .Fill.ForeColor.RGB = RGB(255, 222, 129)
                    .Fill.BackColor.RGB = RGB(208, 154, 0)
                End With
            End If
        Next
    Next
End With

End Sub

Answer 1

我看到你成功了。如果您不喜欢您使用的 RGB 颜色，我会先在 PowerPoint UI 中设计样式，然后对您设计的内容进行编码。要拥有多站（超过 2 个）渐变，您可以像这样添加停靠点：

Sub TableCellGradient()
  Dim oSh As Shape
  Dim oTbl As Table
  Dim lRow As Long ' your i
  Dim lCol As Long ' your j
  Set oSh = ActiveWindow.Selection.ShapeRange(1)
  Set oTbl = oSh.Table

  With oTbl
    For lRow = 1 To .Rows.Count
      For lCol = 1 To .Columns.Count
        If .Cell(lRow, lCol).Selected Then
          With .Cell(lRow, lCol).Shape.Fill
            .TwoColorGradient msoGradientHorizontal, 1
            .ForeColor.RGB = RGB(255, 222, 129)
            .BackColor.RGB = RGB(208, 154, 0)
            .GradientStops.Insert RGB(255, 255, 255), 0.5, 1
          End With
        End If
      Next
    Next
  End With
End Sub