Consulting

Results 1 to 1 of 1

Thread: Problem with macro which position, scale and crop an image

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Joined
    Aug 2017
    Posts
    1
    Location

    Problem with macro which position, scale and crop an image

    Hi guys,

    I'm trying to do a macro which take each parameter used in powerpoint in format picture/crop.

    Crop
    Picture position
    Width Value height Value
    Offset X Value Offset Y Value
    Crop Position
    Width Valueheight Value
    Left Value Top Value

    I've only problems with offset X and offset Y which doesn't update when I'm using the macro.
    For the other things, it takes the value I've got. I'm using a function to change the units to centimeter.

    Here below is the code used :

    Function in2Points(inVal As Single) As Single
    in2Points = inVal * 72 / 2.54
    End Function
    
    Sub MyCrop2()
    Dim oShp As Shape
    Set oShp = ActiveWindow.Selection.ShapeRange(1)
    If oShp.Type = msoPicture Then
    'is it a picture?
    With oShp.PictureFormat
    .Crop.PictureWidth = in2Points(11.95)
    .Crop.PictureHeight = in2Points(8.99)
    .Crop.PictureOffsetX = in2Points(1.46)
    .Crop.PictureOffsetY = in2Points(1.09)
    .Crop.ShapeWidth = in2Points(8.08)
    .Crop.ShapeHeight = in2Points(6.17)
    .Crop.ShapeLeft = in2Points(8.96)
    .Crop.ShapeTop = in2Points(0.32)
    End With
    End If
    'is it a placeholder with a picture in it?
    If oShp.Type = msoPlaceholder Then
    If oShp.PlaceholderFormat.ContainedType = msoPicture Then
    With oShp.PictureFormat
    .Crop.PictureWidth = in2Points(11.95)
    .Crop.PictureHeight = in2Points(8.99)
    .Crop.PictureOffsetX = in2Points(1.46)
    .Crop.PictureOffsetY = in2Points(1.09)
    .Crop.ShapeWidth = in2Points(8.08)
    .Crop.ShapeHeight = in2Points(6.17)
    .Crop.ShapeLeft = in2Points(8.96)
    .Crop.ShapeTop = in2Points(0.32)
    End With
    End If
    End If
    'you will probably want to set the left and top too
    End Sub
    Thank you for your help!
    Last edited by Bob Phillips; 08-07-2017 at 12:21 PM. Reason: Added code tags

Posting Permissions

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