Consulting

Results 1 to 3 of 3

Thread: How to start Compress Pictures from VBA

  1. #1
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    142
    Location

    How to start Compress Pictures from VBA

    Hi,

    PowerPoint has this function Compress Pictures on the Pictures toolbar. Is it possble to active it from VBA, e.g., one of a few steps of a macro working on Pictures like this:

    Sub PictureWork()
    Dim shp As Shape
    
    For Each shp In ActiveWindow.Selection.ShapeRange
    If shp.Type <> msoPicture Then
    MsgBox "Please select Pictures only"
    Exit Sub
    Else
    shp.PictureFormat.ColorType = msoPicturesGrayscale
    ' shp. - - - activate the CompressPicture function?
    End If
    Next shp
    End Sub
    Would be great, to insert it, but I couldn't find it in the object library. Thank you for help.


    By the way: Is something wrong with this Forum? I couldn't paste in my code, I had to type it, which wasn't fun either, because about every second letter gets lost while typing fast. :-(

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,686
    Location
    It's not in the object model as such but this clumsy workaround should work

    Sub compressor()
    Dim opic As Shape
    Set opic = ActiveWindow.Selection.ShapeRange(1)
    If opic.Type = msoPicture Then
    CommandBars.ExecuteMso ("PicturesCompress")
    SendKeys "%{e}" 'chooses Email
    SendKeys "{ENTER}"
    End If
    If opic.Type = msoPlaceholder Then
    If opic.PlaceholderFormat.ContainedType = msoPicture Then
    CommandBars.ExecuteMso ("PicturesCompress")
    SendKeys "%{e}"
    SendKeys "{ENTER}"
    End If
    End If
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    142
    Location
    Wow! Great!

    I assume, if I want the user to choose between the optional resolutions, I just have to delete the line

    SendKeys "(ENTER)"
    Then the input box appears.

    Thank you and have a nice weekend!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •