I have this great EE written Macro (by Dmille, Phillip Burton, JSRWilson) that takes images from excel, based on range names and then places them on separate sheets in a PPT. Here's my question. Is there one or two lines of code that when the image is placed into PPT, it will auto adjust to center it and size it based on the size of the range? It may be a "tweek" to several lines that Dave originally put into the routine. Right now, it sends it over but then you have to align each slide and the image.
Here is the code;
Const l_ppPasteEnhancedMetafile = 2
Const ppLayoutBlank = 12
'The "..._v3" version of the code copies pictures from excel whereas the "..._v2" version copies chart objects.
'NO LONGER NEED TO "Set a VBE reference to Microsoft PowerPoint Object Library"
'RB: changed to late binding by changing the powerpoint related declarations to "as object" (& declaring constants too) to prevent the need for setting a Reference (ie the previous line is no longer necessary).
Const ppViewNormal As Long = 9
Const ppLayoutText As Long = 2
Dim PPApp As Object 'PowerPoint.Application
Dim PPPres As Object 'PowerPoint.Presentation
Dim PPSlide As Object 'PowerPoint.Slide
Dim PresentationFileName As String
Dim SlideCount As Long
Dim iCht As Long
Dim sTitle As String
Dim rImages As Range
Dim rImage As Range
Dim myPaste As Object
Dim wkb As Workbook
Dim wks As Worksheet
Dim chkObj As Object
Set wkb = ThisWorkbook
'check for an existing instance of PowerPoint & if one doesn't exist then open one.
On Error Resume Next
Set PPApp = GetObject(, "Powerpoint.Application")
On Error GoTo 0
If PPApp Is Nothing Then
Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = msoTrue
'DLM: Check to see if any presentations exist. Use the existing active presentation if so, or add one if no
If PPApp.Presentations.Count = 0 Then
Set PPPres = PPApp.Presentations.Add(msoTrue)
Set PPPres = PPApp.ActivePresentation
Set rImages = wkb.Names("OutputPPTRanges").RefersToRange
For Each rImage In rImages
'find range or image/chart
On Error Resume Next
Set chkObj = wkb.Names(rImage.Value).RefersToRange
If Err.Number <> 0 Then
For Each wks In wkb.Worksheets
Set chkObj = wks.Shapes(rImage.Value)
If Err.Number = 0 Then
If rImage.Value <> vbNullString And Err.Number = 0 Then 'found a valid range from the range name
' Add a new slide and paste in the chart
SlideCount = .Count
Set PPSlide = .Add(SlideCount + 1, ppLayoutBlank)
''RB: "activewindow" removed (can be deleted) in case you move the ".visible = true" to the end of the macro
'' paste and select the chart picture
'RB: where possible avoid using ".select" as it slows code down, therefore I have changed the above to the below...
Set myPaste = .Shapes.PasteSpecial(l_ppPasteEnhancedMetafile)
' Align the pasted range
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
' Position pasted chart
.Width = PPPres.PageSetup.SlideWidth - 20
.Left = 100
.Top = 160
.TextFrame.TextRange.Text = sTitle
.Top = 90
.Height = 60
'PPApp.Visible = msoTrue
'RB: if you want to save the ppt file you may be able to modify the next line of code...
PPPres.SaveAs Filename:=PresentationFileName = Environ("USERPROFILE") & "\Desktop\" & "PMQ Workbench.pptx"
' PPres.SaveAs Filename:="c:\PathName\&PresentationFileName=Environ("USERPROFILE")&"\Desktop\"&"MyFile.pptx"
MsgBox "Output to Powerpoint Complete", vbOKOnly + vbMsgBoxSetForeground, "MACRO HAS FINISHED!"
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
' Set Source_ws = Nothing
Thanks in advance!