VBA Powerpoint修改活动表格单元格渐变

Question

我试图在Powerpoint中创建一个宏，它将调整选定表格中所选单元格的渐变&填充设置。

我已经使用Excel轻松完成了这项工作，但我无法将它复制到Powerpoint，我设法调整单个填充颜色。一直在各种网站上阅读，但尚未取得任何进展，将不胜感激关于如何我可以产生相同的效果，我在下面的Excel代码中创建的任何建议。

*编辑：得到它有点工作，但仍然不是100％满意的颜色。

的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 

---

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 

末次

Answer 1

我看看你得到了它的工作。如果您不喜欢您使用过的RGB颜色，我会首先在PowerPoint用户界面中设计样式，然后对您设计的内容进行编码。为了有一个多站（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