Use VBA to Make a Picture Transparent in Microsoft Office

Introduction

I have often wondered why you cannot simply set the transparency of a picture you paste in PowerPoint. Unless you are prepared to paste the picture into a rectangle shape and use the fill command 'paste from clipboard', there is no way to do it. In this tip, I'll show how to use simple VBA to achieve this. I have the code running from a button in a ribbon to work on a selected picture in a PowerPoint slide:

but the code should work with any shape from the ShapeCollection in any MSOffice app.

Using the Code

The core routine is a sub which acts on a selected object in PowerPoint (working for versions 2010 and 2013) called makeTransp(keepOriginal As Boolean) in a code module. I run the routine from a button from a custom ribbon. The code looks for a current selection of shapes in Powerpoint. In the code snippets following the core routine, I'll show how to set up the trapping of the selection events in PowerPoint.

First, the routine will check if there are any shapes selected and, secondly, if the first selected shape is of type msoPicture. If this isn't the case, the sub exits silently or with a warning.

If the routine finds a usable picture, it will export the shape to a temp image file. The reason for this is the fact that a newly created (rectangle) shape can only be filled using fillmode 'UserPicture'. Once the picture has been exported, I create a new shape on the current slide with AddShape using the dimensions of the original picture. Depending on the switch to keep the original picture or not, I offset the new shape by 10 units. As is the custom with pictures, I lock the AspectRatio by default. Subsequently, I fill the new shape with the image from the file and put the fill's transparency to 50%. The user him/herself can then go to the properties of the new shape and tweak the transparency further. Depending on the switch keepOriginal I delete the original picture. Lastly, I clean up the temp image file.

Core routine in code module1:

'VBA code:
Private Sub makeTransp(keepOriginal As Boolean)
    If currentApp.SelectedShapes Is Nothing Then Exit Sub
    If currentApp.SelectedShapes.Count < 1 Then Exit Sub
    
    Dim s As Shape
    Set s = currentApp.SelectedShapes(1)
    
    If s.Type <> msoPicture Then
        MsgBox "Selected object is not an image or picture", _
        	vbExclamation, "Office Tools"
    Else
        Dim fname As String
        fname = Environ("Temp") & "\tmpimagename.jpg"
        'Debug.Print "exporting image to: " & fname
        s.Export fname, ppShapeFormatJPG
        
        Dim sld As Slide
        Set sld = Application.ActiveWindow.View.Slide
        
        Dim shp As Shape
        Dim offset As Integer
        offset = 0
        If keepOriginal Then
            offset = 10
        End If
        Set shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, _
                     Left:=s.Left + offset, Top:=s.Top + offset, _
                     Width:=s.Width, Height:=s.Height)
        shp.LockAspectRatio = msoTrue
        shp.Fill.UserPicture (fname)
        shp.Fill.Transparency = 0.5
        deleteFile fname
        If Not keepOriginal Then
            s.Delete
        End If
    End If
End Sub

In the above routine, the currentApp class holds the runtime info on any current selection. This class is called rpvEvents and is declared WithEvents in a class module within the same VBA project:

'VBA code:
Public WithEvents App As Application
Public SelectedShapes As ShapeRange

Private Sub App_WindowSelectionChange(ByVal sel As Selection)
    With sel
        If .Type = ppSelectionShapes Then
            'Debug.Print "shape selected"
            Set SelectedShapes = sel.ShapeRange
        Else
            Set SelectedShapes = Nothing
        End If
    End With
End Sub

The class is initialized when the code of module1 is loaded:

'VBA code:
Option Explicit
Dim currentApp As New rpvEvents

Public Sub rpvOnLoad()
    Debug.Print "initialize 6nov2015..."

    'start a new application event handler
    Set currentApp.App = Application
End Sub

The little routine to delete the tempfile looks like this in module1:

'VBA code:
Private Sub deleteFile(path As String)
    On Error Resume Next
    Kill path
End Sub

An example of an original image copied into a transparent shape is shown here (smart readers will guess my home country... it's a dead give-away):

Points of Interest

VBA isn't my native language (VB.NET is) and it is obviously very much the ugly little sister in the various language families. However, I make use of it once in a while when I need to automate my work with MSOffice. And you can make your colleagues happy with a simple macro they can use every day.

History

My first article on my first topic.