• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 177
  • Last Modified:

Output from Excel Graphics to PPT - Slight modification for file name/location

EE Pros;

I have a great Macro that DMille and JRWilson helped me with back in 2012.  I'm trying to use it again in a new spreadsheet.  Here is my problem.  I've created the range names but when I run this macro, I can't find where it has placed the output (the new PPT).  I think it's in the last section of this macro or I may need to specify it on the line;

    PPPres.SaveAs Filename:=PresentationFileName

Thank you for taking a look at this for me.

B.


'MODULE FOR OUTPUTING RANGES, OBJECTS AND GRAPHICS TO POWERPOINT

Const l_ppPasteEnhancedMetafile = 3
Const ppLayoutBlank = 12
Sub ChartToPPT_vDLMILLE()
'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
    End If

    '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)
    Else
        Set PPPres = PPApp.ActivePresentation
    End If

    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
            Err.Clear
            For Each wks In wkb.Worksheets
                Set chkObj = wks.Shapes(rImage.Value)
                If Err.Number = 0 Then
                    Exit For
                End If
                Err.Clear
            Next wks
        End If
       
        chkObj.Copy
       
        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
            With PPPres.Slides
                SlideCount = .Count
                Set PPSlide = .Add(SlideCount + 1, ppLayoutBlank)
            End With
   
            ''RB: "activewindow" removed (can be deleted) in case you move the ".visible = true" to the end of the macro
            'PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex

            With PPSlide
                '' paste and select the chart picture
                '.Shapes.Paste.Select
                '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)
               
                With myPaste
                   
                    ' Align the pasted range
                    .Align msoAlignCenters, True
                    .Align msoAlignMiddles, True
   
                    ' Position pasted chart
                    .Left = 10
                    .Top = 160
                End With
   
                With .Shapes.Placeholders(1)
                    .TextFrame.TextRange.Text = sTitle
                    .Top = 90
                    .Height = 60
                End With
   
            End With
        End If
    Next rImage

    '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

    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
End Sub
0
Bright01
Asked:
Bright01
  • 2
  • 2
  • 2
  • +1
2 Solutions
 
Rgonzo1971Commented:
Hi,

In you code no value is assigned to

PresentationFileName

Regards
0
 
Phillip BurtonCommented:
Add the path name before PresentationFileName, e.g.

PPPres.SaveAs Filename:="c:\PathName\" & PresentationFileName
0
 
JSRWilsonCommented:
PresentationFileName doesn't ever seem to be set to an address.

Add this

PresentationFileName=Environ("USERPROFILE")  & "\Desktop\" & "MyFile.pptx"

It should then end up on the desktop called MyFile.pptx
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Bright01Author Commented:
John and Phillip,

I think I made the changes you suggested (I actually am only using John's as indicated below....but tried both ways).  It's still not printing to the desktop.  

Any ideas?

Much thanks,

B.


Sub ChartToPPT_vDLMILLE()
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
    End If

    '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)
    Else
        Set PPPres = PPApp.ActivePresentation
    End If

    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
            Err.Clear
            For Each wks In wkb.Worksheets
                Set chkObj = wks.Shapes(rImage.Value)
                If Err.Number = 0 Then
                    Exit For
                End If
                Err.Clear
            Next wks
        End If
       
        chkObj.Copy
       
        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
            With PPPres.Slides
                SlideCount = .Count
                Set PPSlide = .Add(SlideCount + 1, ppLayoutBlank)
            End With
   
            ''RB: "activewindow" removed (can be deleted) in case you move the ".visible = true" to the end of the macro
            'PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex

            With PPSlide
                '' paste and select the chart picture
                '.Shapes.Paste.Select
                '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)
               
                With myPaste
                   
                    ' Align the pasted range
                    .Align msoAlignCenters, True
                    .Align msoAlignMiddles, True
   
                    ' Position pasted chart
                    .Width = PPPres.PageSetup.SlideWidth - 20
                    .Left = 100
                    .Top = 160
                End With
   
                With .Shapes.Placeholders(1)
                    .TextFrame.TextRange.Text = sTitle
                    .Top = 90
                    .Height = 60
                End With
   
            End With
        End If
    Next rImage

    '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"
    'PPPres.SaveAs Filename:=PMQWorkbench.ppt
    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
End Sub
0
 
Phillip BurtonCommented:
There are mistakes in both of the above. Both

PPPres.SaveAs Filename:=PresentationFileName = Environ("USERPROFILE") & "\Desktop\" & "PMQ Workbench.pptx"

and

'    PPres.SaveAs Filename:="c:\PathName\&PresentationFileName=Environ("USERPROFILE")&"\Desktop\"&"MyFile.pptx"

should read

PPPres.SaveAs Filename:= Environ("USERPROFILE") & "\Desktop\" & "PMQ Workbench.pptx"
0
 
JSRWilsonCommented:
I was suggesting something like

PresentationFileName = Environ("USERPROFILE") & "\Desktop\" & "PMQ Workbench.pptx"
PPPres.SaveAs Filename:=PresentationFileName
0
 
Bright01Author Commented:
John and Phillip,  GREAT JOB!  I used John's code in the end but both solutions are very helpful.  Thank you so much for the quick response.  I'm now turning attention to defining the graphics that will go into the PPT and properly naming the PPT as it is placed on the desktop.  I'll probably be authoring some more questions on this code.  Thanks again.... really appreciate the help and support.   I don't know how you guys got so good on such coding.

B.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now