Extract colors from a gradient [VBA]

ImCattastic 0
Viewed 43

I´m currently working on a small tool for powerpoint to make certain processes easier and one of them is to create a gradient with 2 stops and then extract the colors inbetween so that I can simply create a gradient in powerpoint on a shape, select it, choose how many colors should be generated out of the gradient and then create a group of shapes with the individual colors. However creating the shapes with the colors is not an issue so I would simply like to know whether or not there is any way to extract the colors as described and perhaps how I would achieve it.

Thanks in advance

(Edit : I was able to resolve the issue myself. The code is attached in my answer)

powerpoint vba
1 Answers

Alright, I was able to find a solution myself by breaking down both colors into the respective values and then increase/decrease each value by a percentage of the difference between both colors. I attached the code for anyone interested.


Sub extractGradient()

    Dim sld As Slide
    Dim nShape As shape
    Dim c1, c2, r1, g1, b1, r2, g2, b2, rDiff, gDiff, bDiff, cR, cG, cB  As Long
    Dim range As Integer
    Dim colors As Collection
    
    Set sld = Application.ActiveWindow.View.Slide
    Set colors = New Collection
    range = 1000
       
    With ActiveWindow.Selection.ShapeRange(1).Fill.ForeColor
        
        c1 = .RGB
        r1 = .RGB Mod 256
        g1 = .RGB \ 256 Mod 256
        b1 = .RGB \ 65536 Mod 256

    End With
    
    With ActiveWindow.Selection.ShapeRange(2).Fill.ForeColor
       
        c2 = .RGB
        r2 = .RGB Mod 256
        g2 = .RGB \ 256 Mod 256
        b2 = .RGB \ 65536 Mod 256

    End With
    
    rDiff = Abs(r2 - r1)
    gDiff = Abs(g2 - g1)
    bDiff = Abs(b2 - b1)

    colors.Add c1
    
    For i = 1 To range - 1
    
        cR = IIf(r1 > r2, r1 - (rDiff / range * i), r1 + (rDiff / range * i))
        cG = IIf(g1 > g2, g1 - (gDiff / range * i), g1 + (gDiff / range * i))
        cB = IIf(b1 > b2, b1 - (bDiff / range * i), b1 + (bDiff / range * i))

    
        colors.Add (RGB(cR, cG, cB))
    
    Next i
    
    colors.Add c2

    count = 0

    For Each c In colors
        
        Set nShape = sld.Shapes.AddShape(Type:=msoShapeRectangle, left:=(1 * count), top:=50, width:=1, height:=50)
        
        nShape.Fill.ForeColor.RGB = c
        nShape.Line.Visible = msoFalse
        
        count = count + 1
        
    Next c
    
    
End Sub
ImCattastic0
Related