We help IT Professionals succeed at work.

Is there a VBA equivalent of MS Office Recolor bitmap image feature?

1,096 Views
Last Modified: 2018-02-06
I'm looking for the VBA equivalent of the Picture Tools, Format, Color, Recolor feature in MS Office.  This is available via the contextual ribbon menu (I'm working in PowerPoint) when you select a bitmap image.  Embedded below is a sample bitmap from our corporate icon library.  The color splash behind the black drawing recolors beautifully to any color you choose using the above feature.  clock icon green iconEverything I have read online suggests that Microsoft did not expose this method for direct manipulation in VBA.  I hope the posts are mistaken!

Does anybody know how to accomplish this?  Is this method maybe available in newer versions of Office? (I currently use 2010 but will be upgrading soon to 2016)  Or does anybody know of a robust workaround?  Assuming the icons are all like the ones above, consisting of black, one color, or transparent, I might be able to use getpixel and setpixel to do it the hard way if necessary.  I've read about those but have no experience using them.

Thanks for any suggestions!
Comment
Watch Question

I join to the question!
PowerPoint Technical Consultant
CERTIFIED EXPERT
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
Bryce BassettFreelance VBA programmer

Author

Commented:
Jamie:

Thanks for your very thorough analysis of the options!  Confirms what I had read, that there isn't a direct way to recolor in VBA.  

I love your solution for using the source .EPS files to create PowerPoint vectors that can be recolored.  Our design group works on Macs (of course) and has deliberately deployed the icon library as .PNGs in the past, in three different color schemes to match our three corporate divisions.  But they realize that's three times the work, and hard to keep in synch, so I'm sure they will be open to this solution.  Let me work with them and report back before I close the question, but I think this is my answer.  Thanks!
Bryce BassettFreelance VBA programmer

Author

Commented:
Based on Jamie's suggestion, I've written up a test routine for identifying and converting the color of the swoosh.  I converted the original EPS and re-saved as EMF because I need to have these icons living as external files in a content library.  The code below imports the EMF (of course this would be a more elaborate file picker), ungroups it, finds the color swoosh, and recolors it.  The one part that feels a bit contrived is having to re-find the ungrouped shape.  Is there a more elegant way to do that?  Or any other improvements you would suggest to streamline this code?  Thanks for your help.

Sub recolorswoosh()

Dim x As Integer
Dim iconpicked As String
Dim myshape As Shape
Dim currentslide As Slide
Dim refindleft As Single
Dim refindtop As Single
Dim myMSshape As Shape
Dim farthestleft As Single
Dim myswoosh As Shape

iconpicked = "C:\Test\nuclear.emf"

Set currentslide = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)
Set myshape = currentslide.Shapes.AddPicture(FileName:=iconpicked, linktofile:=msoFalse, _
        savewithdocument:=msoTrue, Left:=200, Top:=200)
findleft = myshape.Left 'store left edge of imported EMF so we can refind it later
findtop = myshape.Top 'store top edge of imported EMF so we can refind it later

myshape.Ungroup 'convert EMF to Microsoft Office drawing object so we can manipulate it

'find the converted shape by matching stored coordinates
For Each myshape In currentslide.Shapes
    If myshape.Left = findleft And myshape.Top = findtop Then
        Set myMSshape = myshape
        Exit For
    End If
Next

'the left most shape will be the swoosh in every case.  Iterate the shapes to identify it.
farthestleft = 1200
For x = 1 To myMSshape.GroupItems.count
    Set myshape = myMSshape.GroupItems(x)
    If myshape.Left < farthestleft Then
        Set myswoosh = myshape
        farthestleft = myshape.Left
    End If
Next x

MsgBox "The swoosh is named " & myswoosh.Name & vbCrLf & " located at left = " & myswoosh.Left & vbCrLf & " filled with color " & myswoosh.Fill.ForeColor

myswoosh.Fill.ForeColor.RGB = RGB(255, 0, 0)

End Sub

Open in new window

File attached.
nuclear.emf
Jamie Garroch (MVP)PowerPoint Technical Consultant
CERTIFIED EXPERT

Commented:
Hi versatilebb. I believe the original question has been answered and this is now a new question about managing EMF groups. To keep EE 'clean' I would suggest closing this question and opening a new question so the answer to this new question can be easily found. There are several suggestions I can make for you.
Bryce BassettFreelance VBA programmer

Author

Commented:
Thanks for your help.  The EPS import and vector shapes method works great.  Transferring to a new question on that topic