Picture Effects Objects

OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

http://startbigthinksmall.wordpress.com/2010/01/04/points-inches-and-emus-measuring-units-in-office-open-xml/

Picture Effects in PowerPoint 2010+

In PowerPoint 2010 you can make use of the powerful PictureEffects object to create a list of effects to applied to a picture which are applied in sequence to the shape to create the final composited image. The effects can be added, moved and deleted from the chain. This also means that the properties of Brightness, Contrast etc are no longer functional in PPT 2010. They are now a part of the picture effects chain. Also, the recolor options continue to remain out of object model support. See the snippets below to apply and then read the information for the effects applied on the picture.

Supported versions: PowerPoint 2010+

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or 
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' -------------------------------------------------------------------------------

Sub ApplyEffect()
Dim shp As Shape
'Assuming that the select shape is a picture
Set shp = ActiveWindow.Selection.ShapeRange(1)
With shp.Fill.PictureEffects
    'Add a line drawing effect with 50% transparency and pencil size 1
    With .Insert(msoEffectLineDrawing)
        .EffectParameters.Item(1).Value = 0.5
        .EffectParameters.Item(2).Value = 1
    End With
    
    'Add 300% saturation
    With .Insert(msoEffectSaturation)
        .EffectParameters.Item(1).Value = 3
    End With
    
    'Soften the image 50%
    With .Insert(msoEffectSharpenSoften)
        .EffectParameters.Item(1).Value = -0.5
    End With
    
End With
End Sub

Sub EnumAppliedPictureEffects()
Dim shp As Shape
Dim i As Integer
Dim j As Integer

Set shp = ActiveWindow.Selection.ShapeRange(1)

With shp.Fill.PictureEffects
    For i = 1 To .Count
        
        Debug.Print "Position:" & .Item(i).Position
        Debug.Print "Type:"; .Item(i).Type
        Debug.Print "Visibility:" & .Item(i).Visible
        Debug.Print "Number of parameter:" & .Item(i).EffectParameters.Count
        
        For j = 1 To .Item(i).EffectParameters.Count
            With .Item(i).EffectParameters(j)
            Debug.Print vbTab & "Parameter name: " & .Name & vbTab & "Value: " & .Value
            End With
        Next
        
        Debug.Print "----------------------------"
    Next
End With
End Sub