Photo size problem

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

After a few days of internet searching and trial and error, the only thing I found that worked was.

Code: Select all

ActiveSheet.Shapes.SelectAll
Even though this approach took a couple additional steps to complete the photo compression.
Once photo(s) have been selected, select "Format" on toolbar
Next select “Compress Pictures”
Format.jpg
Check box “Apply to selected pictures only” then select options
format2.jpg
I then made my selections, then selected OK and then OK again to complete compression process
format3.jpg
And each worksheet would have to be done separately. I could not find any way to compress all photos at once (excel 2007) that would serve my needs.
My workbooks could hold anywhere between 20 to 200 photos and could get quite large. From 30mb before compression to 5mb after compression.
I’m sure we all like that simple click of a button to full fill our needs; sometimes it takes a little work. :grin:

All in all it served my purpose well. I have become pretty proficient with this approach and only takes 5 to 10 seconds to complete. :clapping:
You do not have the required permissions to view the files attached to this post.

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Photo size problem

Post by Rudi »

I found this code that will activate the compress pictures dialog.
I know that SendKeys is not very reliable...but maybe that can confirm the dialog ??

Code: Select all

    ActiveSheet.Shapes.SelectAll
    Dim octl As CommandBarControl
    With Selection
        Set octl = Application.CommandBars.FindControl(ID:=6382)
         octl.Execute
    End With
Also (if the above and the SendKeys does work), it can be placed into a loop that will open each workbook from a folder and then the ENTIRE process is automated...
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

Thanks Rudi, but for some reason it just does not compress. I still have to manually navigate to complete the process in order to see the changes.

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

I have done more experimenting and what I found was that by default the “Apply to select pictures only” is unchecked. But if I manually go to the dialog and first check “Apply to select pictures only” and then select OK button it then seems to compress.
Compress Pic.jpg
Using this code doesn’t give you this option to only select “Apply to select pictures only” it grayed out.
Compress3.jpg
You do not have the required permissions to view the files attached to this post.

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

I found a way to compress all pictures on ActiveSheet, but I first have to check the box “ Apply to selected photos only” (Excel 2007), this only has to be done once as long as the workbook is left open the checkbox will remain checked. Is there a way to have this selecting/checkbox made either through a default setting or code.
My next question is will this code also function with excel 2010 or 2013
Here is the code that I currently using

Code: Select all

Sub SelectPicture(control As IRibbonControl)
    Dim shp As Shape
    Dim f As Boolean
    For Each shp In ActiveSheet.Shapes
        Select Case shp.Type
        Case msoLinkedPicture, msoPicture
            shp.Select Replace:=Not f
            f = True
        End Select
    Next shp

    With Selection
        Application.SendKeys "%(oe)~{TAB}~"
        Application.CommandBars.ExecuteMso "PicturesCompress"
    End With

    ActiveSheet.Range("A4").Select

End Sub

User avatar
HansV
Administrator
Posts: 78233
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Photo size problem

Post by HansV »

The code that you posted reduced a workbook with some large photos from 10 MB to 100 KB in Excel 2010 without having to tick any check boxes before running it.
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

Thanks Hans, I’m guessing 2013 may return the same results since 2010 and 2013 picture compression are similar. It seems that 2007 is a little differnt

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

Again I wonder if there is some type of default setting that could help correct this on 2007

User avatar
HansV
Administrator
Posts: 78233
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Photo size problem

Post by HansV »

I can't find anything that would do that.
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

I couldn’t find anything on this subject also

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

I added some additional code so that I could check the box to select “Apply to selected pictures only”, since I was having a problem with this before using code.
format2.jpg
This is what I added

Code: Select all

        Application.SendKeys "aw{ENTER}{ESC}{ESC}", False
Here is how I applied code

Code: Select all

Sub SelectPicture(control As IRibbonControl)
    Dim shp As Shape
    Dim f As Boolean

    For Each shp In ActiveSheet.Shapes
        Select Case shp.Type
        Case msoLinkedPicture, msoPicture
            shp.Select Replace:=Not f
            f = True
        End Select
    Next shp

    With Selection
        Application.SendKeys "aw{ENTER}{ESC}{ESC}", False
        Application.SendKeys "%(oe)~{TAB}~"
        Application.CommandBars.ExecuteMso "PicturesCompress"
    End With
    ActiveWindow.RangeSelection.Select
End Sub
Its for the most part it seems to work, but sometimes I receive and error message and I’m sure why
Error message.jpg
any thoughts why this is occurring :scratch: and or how I can correct this
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78233
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Photo size problem

Post by HansV »

You send ESC (Escape) using SendKeys. SendKeys is notoriously unreliable - it may send the keystrokes at the wrong moment, and then ESC will cause code execution to pause. I'm not sure it is possible to avoid this.
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

Thank You Hans
I think I may have found a way to eliminate the error message by adding this code (found on line) on first line of macro before error

Code: Select all

Application.EnableCancelKey = xlDisabled
Hopefully I’ll be able to execute the macro successfully without getting the error message “Code execution has been interrupted”.
Even though I may on occasion have to select button to run macro more than once

User avatar
StuartR
Administrator
Posts: 12577
Joined: 16 Jan 2010, 15:49
Location: London, Europe

Re: Photo size problem

Post by StuartR »

I think it would be wise to disable the cancel key for as short a time as possible, and to re-enable it as soon as you can after the sendkeys. While this is disabled you could hang the application altogether if something goes wrong.
StuartR


ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

StuartR wrote:I think it would be wise to disable the cancel key for as short a time as possible, and to re-enable it as soon as you can after the sendkeys. While this is disabled you could hang the application altogether if something goes wrong.
Hi Stuart
Are you referring to something like this

Code: Select all

Sub SelectPicture(control As IRibbonControl)
    Dim shp As Shape
    Dim f As Boolean

    For Each shp In ActiveSheet.Shapes
        Select Case shp.Type
        Case msoLinkedPicture, msoPicture
            shp.Select Replace:=Not f
            f = True
        End Select
    Next shp

    With Selection
        Application.EnableCancelKey = xlDisabled
        Application.SendKeys "aw{ENTER}{ESC}{ESC}", False
        Application.SendKeys "%(oe)~{TAB}~"
        Application.EnableCancelKey = xlInterrupt
        Application.CommandBars.ExecuteMso "PicturesCompress"
    End With
    ActiveSheet.Range("A1").Select
End Sub

User avatar
StuartR
Administrator
Posts: 12577
Joined: 16 Jan 2010, 15:49
Location: London, Europe

Re: Photo size problem

Post by StuartR »

Yes. I was thinking of something like that. It would probably be a good idea to add
Application.DoEvents
before you re-enable the cancel key, to give a chance for things to get flushed out.
StuartR


ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

StuartR wrote:Yes. I was thinking of something like that. It would probably be a good idea to add
Application.DoEvents
before you re-enable the cancel key, to give a chance for things to get flushed out.
Good point, thanks Stuart

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

When I add DoEvents it doesn’t function in the same way (excel 2007)

Code: Select all

    With Selection
        Application.EnableCancelKey = xlDisabled
        Application.SendKeys "aw{ENTER}{ESC}{ESC}", False
        Application.SendKeys "%(oe)~{TAB}~"
        DoEvents
        Application.EnableCancelKey = xlInterrupt
        Application.CommandBars.ExecuteMso "PicturesCompress"
    End With
I get a different dialog on occasion and am not able to select “Selected pictures” its grayed out.
Untitled.jpg
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78233
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Photo size problem

Post by HansV »

Move the lines

Code: Select all

        DoEvents
        Application.EnableCancelKey = xlInterrupt
to below the line

Code: Select all

        Application.CommandBars.ExecuteMso "PicturesCompress"
Best wishes,
Hans

ABabeNChrist
SilverLounger
Posts: 1868
Joined: 25 Jan 2010, 14:00
Location: Conroe, Texas

Re: Photo size problem

Post by ABabeNChrist »

I’m playing around trying different approaches. The code below seems to be working great on ActiveSheet. Can this code be adjusted to do the same thing throughout the entire workbook? Sometimes the workbook may contain a 100+ pictures in various locations and sheets, since this process could take a minute to run, should anything be added for a soother flow such as “Application.ScreenUpdating”

Code: Select all

Private Sub CommandButton1_Click()
    Dim shp As Shape
    Dim f As Boolean

    For Each shp In ActiveSheet.Shapes
        Select Case shp.Type
        Case msoLinkedPicture, msoPicture
            shp.Select Replace:=Not f
            f = True
        End Select
    Next shp

    With Selection
        Application.EnableCancelKey = xlDisabled
        Application.SendKeys "aw{ENTER}{ESC}{ESC}", False
        Application.SendKeys "%(oe)~{TAB}~"
        Application.CommandBars.ExecuteMso "PicturesCompress"
        DoEvents
        Application.EnableCancelKey = xlInterrupt
    End With
    ActiveSheet.Range("A1").Select
End Sub