Advertisement

10.06.2008 at 06:41PM PDT, ID: 23792522
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
8.6

Amend a code to export charts

Asked by JadeCaridad in Microsoft Programming, Microsoft Excel Spreadsheet Software, Microsoft Development

Hi Everyone,

I'm sure the following code may be familiar to some and my attempt here is to modify it in order to capture all the charts in every worksheeti in the workbook.

At the moment it only captures the chart number assigned to CHART NUMBER.   Perhaps I may be missing a step and if so, I'm hoping someone would point it out to me.  At the end of the day, here is what I ultimately am looking to do - capture every chart on every worksheet and export it as a picture to the last slide in  powerpoint.

Thank you for any assistance you can offer)
Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:

Sub Copy_Paste_to_PowerPoint() 
     
     'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE
    Dim ppApp As PowerPoint.Application 
    Dim ppSlide As PowerPoint.Slide 
     
     'Original code sourced from Jon Peltier http://peltiertech.com/Excel/XL_PPT.html
     'This code developed at http://oldlook.experts-exchange.com:8080/Applications/MS_Office/Excel/Q_21337053.html
     
    Dim SheetName As String 
    Dim TestRange As Range 
    Dim TestSheet As Worksheet 
    Dim TestChart As ChartObject 
     
    Dim PasteChart As Boolean 
    Dim PasteChartLink As Boolean 
    Dim ChartNumber As Long 
     
    Dim PasteRange As Boolean 
    Dim RangePasteType As String 
    Dim RangeName As String 
    Dim AddSlidesToEnd As Boolean 
     
     'Parameters
     
     'SheetName           - name of sheet in Excel that contains the range or chart to copy
     
     'PasteChart          -If True then routine will  copy and paste a chart
     'PasteChartLink      -If True then Routine will paste chart with Link; if = False then paste chart no link
     'ChartNumber         -Chart Object Number
     '
     'PasteRange          - If True then Routine will copy and Paste a range
     'RangePasteType      - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values
     'RangeName           - Address or name of range to copy; "B3:G9" "MyRange"
     'AddSlidesToEnd      - If True then appednd slides to end of presentation and paste.  If False then paste on current slide.
     
     'use active sheet. This can be a direct sheet name
    SheetName = ActiveSheet.Name 
     
     'Setting PasteRange to True means that Chart Option will not be used
    PasteRange = True 
    RangeName = "MyRange" 
    RangePasteType = "HTML" 
    RangeLink = True 
     
    PasteChart = True 
    PasteChartLink = True 
    ChartNumber = 1 
     
    AddSlidesToEnd = True 
     
     
     'Error testing
    On Error Resume Next 
    Set TestSheet = Sheets(SheetName) 
    Set TestRange = Sheets(SheetName).Range(RangeName) 
    Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber) 
    On Error Goto 0 
     
    If TestSheet Is Nothing Then 
        MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
     
    If PasteRange And TestRange Is Nothing Then 
        MsgBox "Range " & RangeName & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
     
    If PasteRange = False And PasteChart And TestChart Is Nothing Then 
        MsgBox "Chart " & ChartNumber & " does not exist. Macro will exit", vbCritical 
        Exit Sub 
    End If 
     
     
     'Look for existing instance
    On Error Resume Next 
    Set ppApp = GetObject(, "PowerPoint.Application") 
    On Error Goto 0 
     
     'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application 
     'Add a presentation if none exists
    If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add 
     
     'Make the instance visible
    ppApp.Visible = True 
     
     'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
    If ppApp.ActivePresentation.Slides.Count = 0 Then 
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank) 
    Else 
        If AddSlidesToEnd Then 
             'Appends slides to end of presentation and makes last slide active
            ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank 
            ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count 
            Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count) 
        Else 
             'Sets current slide to active slide
            Set ppSlide = ppApp.ActiveWindow.View.Slide 
        End If 
    End If 
     
     'Options for Copy & Paste Ranges and Charts
    If PasteRange = True Then 
         'Options for Copy & Paste Ranges
        If RangePasteType = "Picture" Then 
             'Paste Range as Picture
            Worksheets(SheetName).Range(RangeName).Copy 
            ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select 
        Else 
             'Paste Range as HTML
            Worksheets(SheetName).Range(RangeName).Copy 
            ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select 
        End If 
    Else 
         'Options for Copy and Paste Charts
        Worksheets(SheetName).Activate 
        ActiveSheet.ChartObjects(ChartNumber).Select 
        If PasteChartLink = True Then 
             'Copy & Paste Chart Linked
            ActiveChart.ChartArea.Copy 
            ppSlide.Shapes.PasteSpecial(link:=True).Select 
        Else 
             'Copy & Paste Chart Not Linked
            ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
            ppSlide.Shapes.Paste.Select 
        End If 
    End If 
     
     'Center pasted object in the slide
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 
     
    AppActivate ("Microsoft PowerPoint") 
    Set ppSlide = Nothing 
    Set ppApp = Nothing 
     
End Sub
[+][-]10.06.2008 at 09:26PM PDT, ID: 22656619

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]10.07.2008 at 09:11AM PDT, ID: 22660811

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.07.2008 at 09:25AM PDT, ID: 22660987

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.07.2008 at 09:28AM PDT, ID: 22661007

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: Microsoft Programming, Microsoft Excel Spreadsheet Software, Microsoft Development
Sign Up Now!
Solution Provided By: byundt
Participating Experts: 1
Solution Grade: A
 
 
[+][-]10.07.2008 at 11:27AM PDT, ID: 22662090

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628