Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Crop a picture in Powerpoint

Posted on 2011-02-13
12
Medium Priority
?
532 Views
Last Modified: 2012-05-11
I would like to know what is wrong with my code below as the cropped image does not end up the right size.

i need the macro to resize the selected image to 12.71cm wide, then to crop off evenly from the top and bottom the left over image above the required height, 3.4cm.  There may be instances where the original image is portrait shape but regardless, its needing to be 3.4 x 12.71 in the end.


Sub CropPic()

    Dim oSlide As Slide
    Dim oPicture As Shape
    Dim oshpR As ShapeRange
    Dim fd As FileDialog
    Dim strFile As String
    Dim sngCropSize As Single

    ' Set oSlide to the first slide in the presentation.
    Set oSlide = ActiveWindow.View.Slide
    Set oPicture = ActiveWindow.Selection.ShapeRange(1)
    oPicture.Width = 363.14
    sngCropSize = oPicture.Height - 97.14
        oPicture.PictureFormat.CropTop = sngCropSize / 2
        oPicture.PictureFormat.CropBottom = sngCropSize / 2
    Set oshpR = oSlide.Shapes.Range(Array(oPicture.Name))
End Sub
0
Comment
Question by:RubyFuse
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 5
12 Comments
 
LVL 23

Expert Comment

by:JSRWilson
ID: 34882980
CropTop and cropBottom crop based on the ORIGINAL size so you need to get the original size and adjust each time the size changes. I think your conversions are slightly out too.

Try:


Sub CropPic()

    Dim oSlide As Slide
    Dim oPicture As Shape
    Dim oshpR As ShapeRange
    Dim fd As FileDialog
    Dim strFile As String
    Dim sngCropSize As Single
    Dim sngOrigHeight As Single
    Dim sngNewheight As Single

    ' Set oSlide to the first slide in the presentation.
    Set oSlide = ActiveWindow.View.Slide
    Set oPicture = ActiveWindow.Selection.ShapeRange(1)
    'Get orig height
    With oPicture.Duplicate
    .ScaleHeight 1, msoTrue
    sngOrigHeight = .Height
    .Delete
    End With
    oPicture.Width = 360.2
        sngNewheight = oPicture.Height
        sngCropSize = (sngNewheight - 96)
        oPicture.PictureFormat.CropTop = (sngCropSize * (sngNewheight / sngOrigHeight)) / 2
        sngNewheight = oPicture.Height
        oPicture.PictureFormat.CropBottom = (sngCropSize * (sngNewheight / sngOrigHeight)) / 2
    Set oshpR = oSlide.Shapes.Range(Array(oPicture.Name))
End Sub

Open in new window

0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 34882983
96 should probably be 96.34 I think
0
 

Author Comment

by:RubyFuse
ID: 34885664
Hi JSRWilson

Unfortunately this still doesn't get the right height, even with the 96.34 changed.  My end height is 7.45 which is half of the original height.

Any other suggestions?

Thanks Ruby
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 23

Expert Comment

by:JSRWilson
ID: 34885945
Did you use all of the code?
0
 
LVL 23

Accepted Solution

by:
JSRWilson earned 2000 total points
ID: 34886028
Ok maybe it should be:

Sub CropPic()

    Dim oSlide As Slide
    Dim oPicture As Shape
    Dim oshpR As ShapeRange
    Dim fd As FileDialog
    Dim strFile As String
    Dim sngCropSize As Single
    Dim sngOrigHeight As Single
    Dim sngNewheight As Single

    ' Set oSlide to the first slide in the presentation.
    Set oSlide = ActiveWindow.View.Slide
    Set oPicture = ActiveWindow.Selection.ShapeRange(1)
    'Get orig height
    With oPicture.Duplicate
    .ScaleHeight 1, msoTrue
    sngOrigHeight = .Height
    .Delete
    End With
    oPicture.LockAspectRatio = True
    oPicture.Width = 360.2
        sngNewheight = oPicture.Height
        sngCropSize = (sngNewheight - 96) / 2
        oPicture.PictureFormat.CropTop = (sngCropSize * (sngOrigHeight / sngNewheight))
        oPicture.PictureFormat.CropBottom = (sngCropSize * (sngOrigHeight / sngNewheight))
    Set oshpR = oSlide.Shapes.Range(Array(oPicture.Name))
End Sub

Open in new window

0
 

Author Comment

by:RubyFuse
ID: 34887383
Yes, used all of the code.
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 34887402
The ammended code seems to do it here.
0
 

Author Closing Comment

by:RubyFuse
ID: 34887407
Excellent, thanks!
0
 

Author Comment

by:RubyFuse
ID: 34887648
If I were to do this for an image size of
0
 

Author Comment

by:RubyFuse
ID: 34887661
Sorry, if I was to do this for an image size of 3.29 x 3.4cm what would need to change?  I added in the dimensions but got a result with a minus crop measurement which mean parts of the image were transparent.  Happy to post this as a separate question if need be.
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 34889414
If you get a negative value it would mean it's impossible to crop to this size. (it's already less)

You would need to set the height and crop left & right maybe.
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 34889428
If you have 2007 onwards you can use a picture placeholder which will auto crop BTW
0

Featured Post

Tech or Treat!

Submit an article about your scariest tech experience—and the solution—and you’ll be automatically entered to win one of 4 fantastic tech gadgets.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Many programs have tried to outwit PowerPoint in terms of technology and skill. These programs, however, still lack several characteristics that PowerPoint has possessed from the start. Here's why PowerPoint replacements won't entirely work for desi…
PowerPoint is the go-to presentation software for millions of users around the world. Many presentations use basic text features but you can really make special text jump out of your slide by applying this bubble text design process. This article ha…
The viewer will learn how to edit text. This includes Font, Spacing, Resizing, Color, and other special text options.
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

618 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question