Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Change background image to greyscale programmatically using VBA in PowerPoint 2010?

Posted on 2014-02-24
5
1,723 Views
Last Modified: 2014-02-26
For a PowerPoint 2010 add-in for our corporate template, I've got a macro button that lets them select an image from the corporate library and insert that as the slide background.  I want to take that one step further and, if they select a specific layout, convert that background image to grayscale.  This is easy to do manually (right-click, format background, picture color, recolor, greyscale), but I need to do it with VBA.  Here is what I've tried:
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "Select Background Image"
fd.InitialFileName = contentlibraryfolder & "\Background Images"

With fd
    If .Show = -1 Then
        pickedpix = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

Set fd = Nothing

currentslide.FollowMasterBackground = False

currentslide.Background.Fill.UserPicture (pickedpix)

If InStr(currentslide.CustomLayout.Name, "B&W") Then
    currentslide.Background.Fill.PictureEffects.Insert(msoEffectSaturation).EffectParameters(1).Value = 0
End If

Open in new window


This works great up to "currentslide.Background.Fill.UserPicture (pickedpix)."  But that last line fails to turn the picture to grayscale.  But it doesn't give me an error either.  I know I'm very close because this same pictureeffects method will turn a regular picture on the foreground of the slide to grayscale, but it's not changing the background.

I'm presenting this in 9 hours at a corporate meeting and would love to include this feature if someone can point me in the right direction.

Thanks!
0
Comment
Question by:versatilebb
  • 2
  • 2
5 Comments
 
LVL 23

Assisted Solution

by:JSRWilson
JSRWilson earned 150 total points
ID: 39889035
You cannot apply picture effects to a background image. You would need to modify an imaga and apply as a background.
0
 
LVL 50

Accepted Solution

by:
Rgonzo1971 earned 350 total points
ID: 39889050
Hi,

pls try
Sub macro()
'Set currentslide = ActivePresentation.Slides(1)
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "Select Background Image"
fd.InitialFileName = contentlibraryfolder & "\Background Images"

With fd
    If .Show = -1 Then
        pickedpix = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

Set fd = Nothing

currentslide.FollowMasterBackground = False

currentslide.Background.Fill.UserPicture (pickedpix)

If InStr(currentslide.CustomLayout.Name, "B&W") = 0 Then
    Set oPic = currentslide.Shapes.AddPicture(FileName:=pickedpix, _
        LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
    oPic.PictureFormat.ColorType = msoPictureBlackAndWhite
    strPicBWName = Left(pickedpix, InStrRev(pickedpix, ".") - 1) & "_bw.jpg"
    oPic.Export strPicBWName, ppShapeFormatJPG
    currentslide.Background.Fill.UserPicture (strPicBWName)
    Kill strPicBWName
    oPic.Delete
Else
    currentslide.Background.Fill.UserPicture (pickedpix)
End If

End Sub

Open in new window

REgards
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39889055
Or maybe just have two master layout one gray and one color. They can easily be applied in code.
0
 

Author Closing Comment

by:versatilebb
ID: 39890426
A few modifications needed, but mostly there.
0
 

Author Comment

by:versatilebb
ID: 39890441
Thanks, Both.  Clever solution to import the image, modify it, export it, pull it in as the background, the nuke the temporary files!  

I did have to make a couple modifications.  ColorType = msoPictureBlackAndWhite gave me a literally 2 toned image, so I want back to the grayscale effect from my original post.  

Also (and you could not have known this), the contentlibraryfolder from which the picture is imported is a read-only network location to which I cannot write files, so I had to parse out the filename and save the temporary file to a local folder.  Here's what I ended up with:
If InStr(currentslide.CustomLayout.Name, "B&W") > 0 Then
    oPicFileName = Right(pickedpix, Len(pickedpix) - InStrRev(pickedpix, "\"))
    strPicBWName = Environ("appdata") & "\" & Left(oPicFileName, InStrRev(oPicFileName, ".") - 1) & "_bw.jpg"
    Set oPic = currentslide.Shapes.AddPicture(FileName:=pickedpix, _
        LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
    oPic.Fill.PictureEffects.Insert(msoEffectSaturation).EffectParameters(1).Value = 0
    oPic.Export strPicBWName, ppShapeFormatJPG
    currentslide.Background.Fill.UserPicture (strPicBWName)
    Kill strPicBWName
    oPic.Delete
Else
    currentslide.Background.Fill.UserPicture (pickedpix)
End If

Open in new window

Thanks for helping me solve this!
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
PowerPoint is the go-to presentation software for millions of users around the world. Many presentations use basic text features but you can really make special text jump out of your slide by applying this bubble text design process. This article ha…
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question