Code: Select all
    
Sub printColumnsColors()
    Dim i As Integer
    Dim s As Slide
    Set s = ActivePresentation.Slides(1)
    For i = 0 To 71
        s.Shapes(i + 1).Fill.ForeColor.RGB = getClr(CLPrms.TextBox1, CLPrms.TextBox2, CLPrms.TextBox3, SingVal(CLPrms.TextBox4), SingVal(CLPrms.TextBox5), SingVal(CLPrms.TextBox6), CLPrms.TextBox7, CLPrms.TextBox8, CLPrms.TextBox9, SingVal(CLPrms.TextBox10.Value), SingVal(CLPrms.TextBox11.Value), SingVal(CLPrms.TextBox12.Value), i)
    Next i
    For i = 72 To 143
        s.Shapes(i + 1).Fill.ForeColor.RGB = getClr(CLPrms.TextBox1, CLPrms.TextBox2, CLPrms.TextBox3, SingVal(CLPrms.TextBox4), SingVal(CLPrms.TextBox5), SingVal(CLPrms.TextBox6), CLPrms.TextBox7, CLPrms.TextBox8, CLPrms.TextBox9, SingVal(CLPrms.TextBox10.Value) - 0.333, SingVal(CLPrms.TextBox11.Value) - 0.333, SingVal(CLPrms.TextBox12.Value) - 0.333, i)
    Next i
    For i = 144 To 215
        s.Shapes(i + 1).Fill.ForeColor.RGB = getClr(CLPrms.TextBox1, CLPrms.TextBox2, CLPrms.TextBox3, SingVal(CLPrms.TextBox4), SingVal(CLPrms.TextBox5), SingVal(CLPrms.TextBox6), CLPrms.TextBox7, CLPrms.TextBox8, CLPrms.TextBox9, SingVal(CLPrms.TextBox10.Value) - 0.667, SingVal(CLPrms.TextBox11.Value) - 0.667, SingVal(CLPrms.TextBox12.Value) - 0.667, i)
    Next i
End Sub
Sub printColumnsColors2()
    Dim n As Integer
    Dim a As Single
    Dim b As Single
    Dim s As Slide
    a = 127.5
    b = 6.28
    Set s = ActivePresentation.Slides(1)
    For n = 0 To 71
        If n >= 0 And n < 24 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(2 * a * (1 - 3 * (n / 72)), Abs(2 * a * (3 * (n / 72 - 1 / 3))), 0)
        If n >= 24 And n < 48 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(0, 2 * a * (1 - 3 * (n / 72 - 1 / 3)), Abs(2 * a * 3 * (n / 72 - 2 / 3)))
        If n >= 48 And n < 72 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(2 * a * (3 * (n / 72)), 0, 2 * a * (1 - 3 * (n / 72 - 2 / 3)))
    Next n
End Sub
Sub allDone()
    Dim i As Integer
    Dim a As Single
    Dim b As Single
    Dim b As Single
    Dim s As Slide
    a = 127.5
    b = 6.28
    Set s = ActivePresentation.Slides(1)
    
    For n = 0 To 71
        If n >= 0 And n < 12 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(255, a * (1 + 2 * Cos(b * (n / 72 - 1 / 3))), 0)
        If n > 11 And n < 24 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(255, 255, a * (1 + 2 * Cos(b * (n / 72 - 1 / 2))))
        If n > 23 And n < 36 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(a * (1 + 2 * Cos(b * (n / 72 - 1 / 6))), 255, 255)
        If n > 35 And n < 48 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(0, a * (1 + 2 * Cos(b * (n / 72 - 1 / 3))), 255)
        If n > 47 And n < 60 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(0, 0, a * (1 + 2 * Cos(b * (n / 72 - 1 / 2))))
        If n > 59 And n < 72 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(a * (1 + 2 * Cos(b * (n / 72 - 1 / 6))), 0, 0)
    Next n
    
    For n = 0 To 71
        If n >= 0 And n < 18 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(255 - Abs(2 * a * (4 * (n / 72 - 1 / 4))), 0, 0)
        If n >= 18 And n < 36 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(255, 255 - Abs(2 * a * (4 * (n / 72 - 2 / 4))), 0)
        If n >= 36 And n < 54 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(255 - Abs(2 * a * (1 - 4 * (n / 72 - 1 / 4))), 255, 0)
        If n >= 54 And n < 72 Then s.Shapes(n + 1).Fill.ForeColor.RGB = RGB(0, 255 - Abs(2 * a * (1 - 4 * (n / 72 - 2 / 4))), 0)
    Next n
    
    
End Sub
Private Function getClr(a As Single, b As Single, c As Single, f As Single, g As Single, h As Single, K As Single, L As Single, M As Single, U As Single, V As Single, W As Single, n As Integer) As Long
    
    getClr = RGB(a * (1 + Cos(f * (n / K + U))), b * (1 + Cos(g * (n / L + V))), c * (1 + Cos(h * (n / M + W))))
    
End Function
Sub showCLParamenters()
    CLPrms.show
End Sub
Function SingVal(strVal As String) As Single
    Dim x As Integer
    Dim a As Integer
    Dim b As Integer
    x = InStr(strVal, "/")
    If x = 0 Then
        SingVal = CSng(strVal)
    Else
        a = Left(strVal, x - 1)
        b = Right(strVal, Len(strVal) - x)
        SingVal = a / b
    End If
End Function
Sub setFs()
    Dim i As Integer
    For i = 1 To 72
        ActivePresentation.Slides(1).Shapes(i).ActionSettings(ppMouseClick).Run = "showCLParamenters"
    Next i
End Sub