在PowerPoint单元格表格中设置两种颜色渐变的VB代码

Question

希望你们一切都好。我被困在编码中，或者你可以说格式问题，我已经尝试了一切，但不知何故我无法弄清楚如何完成它。问题描述如下。

问题： 我们想要一个用于 PowerPoint 的 vba 宏，通过使用我们可以为 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

• 更改的代码标有

  **

• 代码已在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

Answer 2

如果您确实想要 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”上：