Hi Leith,

I haven't heard back from you on the last post so I searched the internet and found a few macros that I was able to sew together and then make it work for my needs. Part of it the macro was authored by A. Pope and the other part was authored by Mr. Peltier.

This is the procedure that worked for me, Copy and paste the first macro in to Excel.

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12

Sub FrankenMacro()
' Do not forget to set a VBE reference to Microsoft PowerPoint Object Library
' This Macro is to be installed in EXCEL

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
    
    keybd_event VK_SNAPSHOT, 1, 0, 0
    DoEvents
    Set PPApp = GetObject(, "Powerpoint.Application")
    Set PPPres = PPApp.ActivePresentation
    
    PPApp.ActiveWindow.ViewType = ppViewSlide
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    PPSlide.Shapes.Paste.Select
    Set PPSlide = Nothing
    
    Set PPPres = Nothing
    Set PPApp = Nothing

End Sub

Then launch Power Point and copy and paste this macro in to Power Point.


Sub ResizeFrankenMacro()

' This macro has to be installed in POWER POINT
' Remeber to change the security settings allowing macros to "Play"
' On the Toolbar, Right Click, Customize, scroll down, Macros, Drag UP to your toolbar

    ActiveWindow.Selection.ShapeRange.PictureFormat.CropLeft = 71.99
    ActiveWindow.Selection.ShapeRange.PictureFormat.CropRight = 239.98
    With ActiveWindow.Selection.ShapeRange
        .IncrementLeft 18#
        .IncrementTop 44.25
    End With
    ActiveWindow.Selection.ShapeRange.PictureFormat.CropTop = 83.99
    With ActiveWindow.Selection.ShapeRange
        .IncrementLeft 30#
        .IncrementTop -192#
    End With
    ActiveWindow.Selection.ShapeRange.PictureFormat.CropBottom = 70.49
    With ActiveWindow.Selection.ShapeRange
        .IncrementLeft -36#
        .IncrementTop 126#
    End With
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth 1.1, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.1, msoFalse, msoScaleFromTopLeft
    End With
    ActiveWindow.Selection.Unselect
End Sub

Once these macros are installed... both Excel and Power Point must be active/open... from Excel execute the macro, it will take a Screen Capture of the active window and paste it in to Power Point... from Power Point execute that macro and it should trim/crop it to the size of the slide.

Best Regards,

This forum is the BEST... BusDriver2