Solved

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

Posted on 2015-01-08
7
172 Views
Last Modified: 2015-01-08
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
Comment
Question by:Bright01
  • 2
  • 2
  • 2
  • +1
7 Comments
 
LVL 50

Expert Comment

by:Rgonzo1971
ID: 40537657
Hi,

In you code no value is assigned to

PresentationFileName

Regards
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40537658
Add the path name before PresentationFileName, e.g.

PPPres.SaveAs Filename:="c:\PathName\" & PresentationFileName
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 40537669
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
Industry Leaders: 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!

 

Author Comment

by:Bright01
ID: 40537909
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
 
LVL 24

Assisted Solution

by:Phillip Burton
Phillip Burton earned 200 total points
ID: 40537919
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
 
LVL 23

Accepted Solution

by:
JSRWilson earned 300 total points
ID: 40537947
I was suggesting something like

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

Author Closing Comment

by:Bright01
ID: 40538008
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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

685 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question