Solved: Macro / VBA to Compress Picture
I am delivering a polwerpoint presentation to a large sales force. I am offering all automation via objects (buttons, text fields, etc) which are visible when in View Show Mode. I need to deliver the same functionality for compressing pictures which can be achieved by doing the following:
Format Pictures -->
Compress -->
Apply to All Pictures in document
I have tried using macro record to see how powerpoint would reflect the steps and the resulting macros is blank.
The best idea I have read so far is to utilize "send keys" but this has serious challenges as well....
I have done some research and this is evidently a tough issue. Major gold star for anyone who can help me find a good solution. Btw, the end game is too optimize file size reduction.
Thanks
Thank you Silvastre ... Much cleaner solution
Quote:
Originally Posted by silvastre
Hi,
I think sendkeys is the best solution together with FindControl. The following code works in PPT 2003 english version. You may need to change %A (Alt+a)and %W (Alt+W) to other keys to navigate the dialogbox.
Sub compress()
Application.CommandBars.FindControl(Id:=6382).Execute
SendKeys "%A%W{ENTER}", False
End Sub
Happy programming
:)
/silvastre
Fantastic! :friends: :bow:
I am grateful you took the time to post your suggestion. I replaced the send key logic I had implemented which was not nearly as clean. See Below snippet. Keep in mind I was artificially selecting an image tagged as "picture"\"fake" to gain access to the menu items needed.
[VBA]
Sub AACompressImages()
Dim oSh As Shape
Dim lCurrSlide As Long
Dim SlideName
Dim intCurrSlide
Dim oSlide As Slide
On Error GoTo errhandler
Set oSlide = ActivePresentation.Slides("chartmanage")
lCurrSlide = oSlide.SlideIndex
ActiveWindow.View.GotoSlide lCurrSlide
Set oSh = Module3.GetShapeTaggedWith("picture", "fake", oSlide)
If Not oSh Is Nothing Then ' we found it
ActivePresentation.Application.DisplayAlerts = ppAlertsNone
oSh.Select
SendKeys "%oi", False
SendKeys "%m", False
SendKeys "aw{ENTER}{ESC}{ESC}", True
Else
MsgBox "Image Not found"
End If
Exit Sub
errhandler:
MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub
[/VBA]
Your code works flawlessly and also eliminates some other hoops I was jumping through. The compress images challenge has been a relative "hack" compared to other functionality I am delivering. This will serve to significantly clean up that process.
Thank you very much!
If I can humbly offer up any assistance with some issues I have worked through please feel free to post.