How to autocrop an image with VBA in PowerPoint?

Question

I am trying to find where the color differs and then crop that part of the image out of it.

Is there any method to get a pixel by pixel image color?

I don't think I can based off of these methods and because it is a bitmap image.

I know there is a set transparent method but the problem is I need to set the widths or heights of logos to be the same height/width and the transparent function doesn't change the size of the picture

If a method does this I would write a function that finds where the image changes from white and then crop from the top middle and bottom.

Example image

Answer 1

I was recently working on a similar problem, and I developed a VBA solution for automatically cropping a white border from an image
In that answer, I am only looking at one side of the image because I assume that the border is uniform all of the way around, so it would not directly work for this case. Also, that example only modifies the slide, and it does not produce an output file

In the below example, each side of the image is examined and cropped according to how much whitespace is found. The resultant slide is then exported back to the original directory with the name croppedFile.

Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Function PixelTest(objPict As Object, ByVal X As Long, ByVal Y As Long) As Long
 Dim lDC As Variant
 lDC = CreateCompatibleDC(0)
 SelectObject lDC, objPict.Handle
 PixelTest = GetPixel(lDC, X, Y)
 DeleteDC lDC
End Function
Sub AutoCropper()
    Dim myDocument As Slide, fileSystem As Object, fileFolder As Object
    Dim fileItem As Object, objPict As Object, objImage As Object
    Dim i As Integer, startingPoint As Integer, endingPoint As Integer
    Dim MidPoint As Integer, filePath As String, fileName As String
    Dim cropScale As Single, margin As Single, reverseScan As Integer
    Dim importHeight As Single, importWidth As Single, resolutionScale As Integer
    Dim xlocation As Single, yLocation As Single
    Dim restoreLayout As Boolean
    filePath = "D:\Pictures"
    fileName = "Example.bmp"
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    Set fileFolder = fileSystem.GetFolder(filePath)
    Set objImage = CreateObject("WIA.ImageFile")
    cropScale = 3.4
    resolutionScale = 10
    importWidth = 330
    importHeight = 250
    xlocation = 390
    yLocation = 200
    For Each fileItem In fileFolder.Files
        If fileItem.Name = fileName Then
            i = i + 1
            On Error GoTo insertSlide
            Set myDocument = ActivePresentation.Slides(i)
            If myDocument.CustomLayout.Name = "Picture with Caption" Then
                myDocument.Layout = ppLayoutText
                restoreLayout = True
            End If
            Set preCroppedPic = myDocument.Shapes.AddPicture(fileName:=fileFolder & "\" & _
                fileItem.Name, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, _
                Left:=xlocation, Top:=yLocation, Width:=importWidth, Height:=importHeight)
            preCroppedPic.Export filePath & "\Temp.bmp", ppShapeFormatBMP, preCroppedPic.Width, preCroppedPic.Height, ppScaleToFit
            Set objImage = CreateObject("WIA.ImageFile")
            objImage.LoadFile filePath & "\Temp.bmp"
            Set objPict = LoadPicture(filePath & "\Temp.BMP")
            endingPoint = objImage.Width
            MidPoint = (0.5 * objImage.Height)
            For marginScan = 1 To endingPoint
                On Error Resume Next
                If Not (PixelTest(objPict, marginScan, MidPoint) Like "1677*") Then
                    margin = marginScan * cropScale
                    preCroppedPic.PictureFormat.CropLeft = margin
                    Exit For
                End If
            Next
            For marginScan = 1 To endingPoint
                reverseScan = endingPoint - marginScan
                If Not (PixelTest(objPict, reverseScan, MidPoint) Like "1677*") Then
                    margin = marginScan * cropScale
                    preCroppedPic.PictureFormat.CropRight = margin
                    Exit For
                End If
            Next
            endingPoint = objImage.Height
            MidPoint = (0.5 * objImage.Width)
            For marginScan = 1 To endingPoint
                If Not (PixelTest(objPict, MidPoint, marginScan) Like "1677*") Then
                    margin = marginScan * cropScale
                    preCroppedPic.PictureFormat.CropTop = margin
                    Exit For
                End If
            Next
            For marginScan = 1 To endingPoint
                reverseScan = endingPoint - marginScan
                If Not (PixelTest(objPict, MidPoint, reverseScan) Like "1677*") Then
                    margin = marginScan * cropScale
                    preCroppedPic.PictureFormat.CropBottom = margin
                  '  finalHeight = finalHeight - margin
                    Exit For
                End If
            Next
            If restoreLayout Then
                myDocument.Layout = ppLayoutPictureWithCaption
                restoreLayout = False
            End If
            preCroppedPic.Export filePath & "\CroppedImage.bmp", ppShapeFormatBMP, (resolutionScale * importWidth), (resolutionScale * importHeight), ppScaleToFit
            Exit For
        End If
    Next fileItem
    Exit Sub
insertSlide:
    Set myDocument = ActivePresentation.Slides.Add(i, ppLayoutText)
    Resume Next
End Sub

The preceding code produces the following result with the precropped image on the left and the postcropped image on the right:

Obviously, a correct file path and file name have to be supplied, but here are a few not so obvious things that need to be taken into consideration when working with this script:
• This program has been tested and confirmed to work for BMP, JPEG, GIF, and PNG files, but the file name and extension are case sensitive, so if you run the code and nothing happens, I would check that first.
• I've tested this on multiple systems, and I've found that the pixel analyzer in this program will not work for PNGs. To make this script PNG compatible, because that is what I normally work with, I had to perform an intermediary file conversion that creates a temporary BMP file. Between the different environments I tested this script on, I found that the export size varied quite a bit, but it was always proportional to the original picture. For this reason, there is a cropScale value that can be used to account for this ratio. A cropScale value of 2 for example will crop 2 white pixels from the original photo for every 1 pixel detected in the temporary bmp.
• Also, due to the export descrepencies, I've found that the export file will often have a lower resolution than the original, so a resolutionScale parameter has been added to compensate for this in the output file. This along with the cropScale parameters should make it simple to get this script working on wide variety of systems.
• Finally, this script can be modified to crop any border color or even gradient colors by modifying the If Not Like parameters in the four cropping loops, but the colors returned from the pixel analyzer are not RGB values. Rather they are Long values.

• A list of Long color values can be found here: Long Color Chart
• For more information on scaling picture sizes and resolutions in PowerPoint, I found this excellent resource while researching this solution:
Unravelling PowerPoint picture size and resolution

Answer 2

As far as I can tell it is impossible to do so within Powerpoint, however there might be a way using outside conditions such as by opening an excel project and using the code from this post VBA Get Colour of Pixel. I'm sorry that I cannot help you in any other way. My main suggestion would be to use normal numbers to crop it. Perhaps if you found a specific thing between the images that was different (Such as one type of image's height was different than the other type of image so you could use that to know how far to crop the image.), however as far as I can tell, No. There is no way to do this with powerpoint unless they added a feature.