在PowerPoint单元格表格中设置两种颜色渐变

Question

我们要为 PowerPoint 选定表格中的选定单元格设置以下格式。

所需输出

我编写了代码来添加它，但我们想要一条 45 度角的水平线。我设法添加了两种颜色渐变，但我无法添加 45 度的水平线，它是从上到下或锐利的。

Sub Fill()
    Dim oSh As Shape

    Dim iStyle          As Integer
    Dim iVariant        As Integer
    Dim iAngle          As Integer
    Dim Col1 As Long
    Dim Col2 As Long
    Dim Col3 As Long
    Col1 = RGB(255, 0, 0) 'red
    Col2 = RGB(255, 192, 0) 'green
    Col3 = RGB(255, 255, 0) 'yellow

    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
                        .GradientStops(1).Color = Col1
                        .GradientStops(1).Position = 0.5
                        .GradientStops(2).Color = Col2
                        .GradientStops(2).Position = 0.5
                        .GradientAngle = 60
                    End With
                End If
            Next
        Next        
    End With
End Sub

Answer 1

如果您确实想要 45 度斜坡无论单元格的高度，您可以使用类似下面的计算来获得非常接近的结果

Sub FillAt45()
    Dim sld As Slide, sh As Shape, n As Long, w, h, r, deg
    
    Set sld = ActivePresentation.Slides(1)
    For n = 0 To 6

        Set sh = sld.Shapes("Box" & n)
        w = sh.Width
        h = sh.Height
        r = (h / w) - 1
        deg = 45 + (45 * (r / (r + 1.3)))
        
        With sh.Fill
           Debug.Print n, r, deg
            .TwoColorGradient msoGradientHorizontal, 1
            .GradientStops(1).Color = RGB(78, 151, 42) ' **
            .GradientStops(1).Position = 0.5
            .GradientStops(2).Color = RGB(241, 184, 68) ' **
            .GradientStops(2).Position = 0.5
            .GradientAngle = deg
            sld.Shapes("Text" & n).TextFrame.TextRange.Text = Round(deg, 2)
        End With
    Next n
End Sub

这是我的测试幻灯片，45 度线位于形状“Box0”到“Box6”上：

注意我只针对

h > w

的情况进行了计算

Answer 2

• 更改的代码标有

  **

• 代码已在M365上测试。

Option Explicit
Sub Fill()
    Dim oSh As Shape
    Dim iStyle          As Integer
    Dim iVariant        As Integer
    Dim iAngle          As Integer
    Dim Col1 As Long
    Dim Col2 As Long
    Dim Col3 As Long
    Col2 = RGB(78, 151, 42) 'green ' **
    Col3 = RGB(241, 184, 68) 'yellow ' **
    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
                        .GradientStops(1).Color = Col2 ' **
                        .GradientStops(1).Position = 0.5
                        .GradientStops(2).Color = Col3 ' **
                        .GradientStops(2).Position = 0.5
                        .GradientAngle = 60
                    End With
                End If
            Next
        Next
    End With
End Sub