Consulting

Results 1 to 1 of 1

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

  1. #1

    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 
    
    
    Formatting tags added by mark007
    Thank you for your help!
    Last edited by xld; 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
  •