locked
Excel 2007 - compress pictures with VBA RRS feed

  • Question

  • I have a workbook (template), which is distributed to 40 plus vendors, who enter data in unlocked fields, insert pictures (via command button/macro), and submit to me for each job that they do.

     

    Please keep in mind that most are machine shops or small repair facilities and in most cases have very limited knowledge of MS Office software. I have basically made the workbook foolproof in that the vendor simply checks boxes, enters data in predefined fields, or click various buttons (labeled) to perform different functions. I must be able to automate everything using VBA to keep things simple for the person doing the data entry.

     

    The problem is that some vendors have installed Excel 2007 and a bit of my code does not work for them and to make matters worse I do not have Excel 2007, nor do I have access to a machine running it.

     

    The part of the macro not working, compresses the inserted .jpg file so as to keep the overall size of the workbook down, (there may be in excess of 100 pictures per workbook). I am using sendkeys to access the compress dialog of the picture toolbar which works great in the 2003 version but not in 2007.

     

    See previous post here…

     

    Excel '03 - sendkeys code doesn't work in '07 version - need help

     

     

     

    What I will do is have the macro check which version of Excel is running and call the appropriate code – here’s where I need your help…

     

    I have found online that in ’07, to compress pictures you would go under Picture Tools , on the Format tab, in the Adjust group, click Compress Pictures . But I need help writing the code to make it happen. I don’t need to worry about the “Automatically compress on Save” option, I just need to be able to compress the selected image.

     

    Can anyone help me out???


    "The new phonebooks are here!"
    Monday, March 15, 2010 7:38 PM

Answers

  • I don't think it is realistic, of you company, to supply and support an application on a version that you do not have access to. And it already sounds as if you have used a trial version for some testing.

    This code works for me but whether it works on all pc's I do not know.

    Sub CompressPic()

        If TypeName(Selection) = "Picture" Then
            Application.SendKeys "%a~"
            Application.CommandBars.ExecuteMso "PicturesCompress"
        End If
       
    End Sub


    Cheers www.andypope.info
    • Marked as answer by suznal Tuesday, March 16, 2010 4:28 PM
    Tuesday, March 16, 2010 3:58 PM

All replies

  • Hi,

    The following will display the dialog for the selected picture(s).

    application.CommandBars.ExecuteMso "PicturesCompress"


    Cheers www.andypope.info
    Tuesday, March 16, 2010 9:14 AM
  • Thanks Andy

    But I don't want to display the dialog, I want the macro to call the dialog, make the appropriate selections and run the compression. In my 2003 code I am using sendkeys to make the appropriate selections on the dialog and select 'enter' to run the compression - I want to do the same for the '07 code.
    I have screenupdating and displayalerts set to false throughout the code for the workbook so that the user never even sees an alert or dialog. Again, I am trying to make this as foolproof as possible - the less the user has to do or see the better.
    Thanks!

    "The new phonebooks are here!"
    Tuesday, March 16, 2010 1:52 PM
  • As with the 2003 version you can not directly do with code that which is possible via the dialogs. Hence the need for sendkeys.

    So the code I gave displays the dialog which you then have to SendKeys the extra keystrokes required to complete the task.

    You might want to try the trial version of office 2007 in order to get passed this problem.
    http://trial.trymicrosoftoffice.com/trialukireland/default.aspx
    Cheers www.andypope.info
    Tuesday, March 16, 2010 2:02 PM
  • There lies the other problem - I do not have access to 2007 so I have for other issues downloaded the trial version (had to do it three times - different machine each time). I am now out of machines to use, and since I already tried it, it will not let me run it again.
    With the present state of the economy I cannot convince my company to buy just a single license - that is why I have come to the forum for help.
    I need either the code, a free version of Excel '07, or instructions on what files need to be modified so that I can run the trial version again, (I don't think the last two are going to happen).
    Anyone?

    "The new phonebooks are here!"
    Tuesday, March 16, 2010 2:40 PM
  • I don't think it is realistic, of you company, to supply and support an application on a version that you do not have access to. And it already sounds as if you have used a trial version for some testing.

    This code works for me but whether it works on all pc's I do not know.

    Sub CompressPic()

        If TypeName(Selection) = "Picture" Then
            Application.SendKeys "%a~"
            Application.CommandBars.ExecuteMso "PicturesCompress"
        End If
       
    End Sub


    Cheers www.andypope.info
    • Marked as answer by suznal Tuesday, March 16, 2010 4:28 PM
    Tuesday, March 16, 2010 3:58 PM
  • I agree Andy - but I'm just trying to collect a paycheck as best I can with what they are willing to supply me with.
    Thanks
    "The new phonebooks are here!"
    Tuesday, March 16, 2010 4:28 PM
  • I never could get compress like  I wanted so I use ImageMagick (free) and call it from Excel via the command line.  I include it in the Inno Setup install file. 
    Tuesday, March 16, 2010 10:55 PM
  • Just posted a reply in the other thread you mention. Just for the record (and so that others like myself who may have been looking for this can find it): the code below compresses all selected images in PowerPoint. This can easily be modified to compress all images in a presentation I feel.

    Public Sub ResizeAndCompressSelectedImages()
        '   Store selected images before we start '
        Dim oShape As Shape
        Dim cShapes As New Collection
        For Each oShape In ActiveWindow.Selection.ShapeRange
            If oShape.Type = msoPicture Then cShapes.Add oShape
        Next oShape
        
        '   Now, reduce the resolution of all of the selected
        '   shapes, one at a time
        Dim prevWidth As Single
        Dim prevHeight As Single
        For Each oShape In cShapes
            prevWidth = oShape.width: prevHeight = oShape.height
            oShape.LockAspectRatio = msoTrue
            oShape.width = 40   '   Something small '
            oShape.Copy
            ActiveWindow.View.PasteSpecial ppPastePNG
            With ActiveWindow.Selection.ShapeRange(1)
                .Left = oShape.            .Top = oShape.Top
                .width = prevWidth:
                .height = prevHeight
            End With
            oShape.Delete
        Next oShape
    End Sub

    Kind regards,

    Bram


    Tuesday, August 13, 2013 5:18 PM