Avatar of Bryce Bassett
Bryce Bassett
Flag for United States of America asked on

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

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!
VBAMicrosoft OfficeMicrosoft Word

Avatar of undefined
Last Comment
Bryce Bassett

8/22/2022 - Mon
Isabella Jones

I join to the question!
ASKER CERTIFIED SOLUTION
Jamie Garroch (MVP)

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Bryce Bassett

ASKER
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 Bassett

ASKER
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
Your help has saved me hundreds of hours of internet surfing.
fblack61
Jamie Garroch (MVP)

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 Bassett

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