	[x] Posted via EE Mobile
	Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again.

Question

	[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!

9.2

VBA - How to store excel range variables into an array and paste into PowerPoint

Asked by Shino_skay in Visual Basic v1.0.5.x, Microsoft Excel Spreadsheet Software, Microsoft Powerpoint Presentation Software

Tags: VBA, Excel, PowerPoint

Hi, I managed to do the following in Excel's VBA environment:

1) Open Powerpoint (if not already open)
2) Open specific Powerpoint file (if not already open)
3) Loop through slide 2-6 and delete the "picture shape" or .type = msoPicture on each slide

Step 4, I want to copy 5 excel ranges from 5 different tabs and paste them as pictures in the corresponding PowerPoint slides (already designed) with a loop.

I'm running into two problems, if I use the following code, I can copy rngPage1 to slide #2 as a picture:

rngPage1.CopyPicture xlScreen, xlPicture
Set objPPTSlide = objPPTPres.Slides(2)
objPPTSlide.Shapes.Paste

However, if I want to loop the process to save space and typing, I'm running into two problems:

1) Cannot store excel range into dynamic array and then, uh call it?
2) Cannot paste the target range, instead pasting everything from the tab (it's definitely because of the line Cells.Copypicture.....I try to omit cells and just leave it as Copypicture but that didn't work)

Thanks everyone for your patience.

View the Solution FREE for 30 Days

         
           
             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:
140:
141:

           
           
             Option Explicit
Option Compare Text 'Case Insensitive
 
Dim objPPTApp As Object, _
    objPPT As Object, _
    objPPTSlides As Object, _
    objPPTPres As Object, _
    objPPTSlide As Object
Dim strTargetFile As String, _
    strDirectory As String
Dim rngPage1 As Range, _
    rngPage2 As Range, _
    rngPage3 As Range, _
    rngPage4 As Range, _
    rngPage5 As Range
    
    
Sub OpenPowerPoint() 'Open PowerPoint Application
 
'The following code will _
1) Open PowerPoint (if it is not already opened), _
2) If PowerPoint application already running, reference an variable to the application _
3) Make PowerPoint visible to ensure proper manipulation
 
'If error, resume the code
On Error Resume Next
 
'Grab PowerPoint (assuming PowerPt is open)
Set objPPTApp = GetObject(, "PowerPoint.application")
 
'If error # is 429, PowerPoint Application is not open at all
If Err.Number = 429 Then
    'Create a new instance of PowerPoint since none are open
    Set objPPTApp = CreateObject("PowerPoint.application")
End If
 
'Make PowerPoint Visible or further manipulation is not possible
objPPTApp.Visible = True
 
End Sub
Sub OpenPPTFile() 'Open Specific PowerPoint Presentation
 
'The following code will _
1) Set up path to target folder _
2) Set up path to PowerPoint file name _
3) If PowerPoint file is not already open _
        a) Open the target Powerpoint File and reference it _
        b) Reference the PowerPoint file if already open
 
'Setting location of Excel Workbook
strDirectory = "H:\apps\xp\Desktop\ScoreCards\" 'Root Directory
strTargetFile = "Test.ppt" 'File Name
 
'If Excel spreadsheet "Test.PPT" is NOT open
If Not IsPPTOpen(strTargetFile) Then
    'set objPPT = Test.PPT
    Set objPPT = objPPTApp.Presentations.Open(strDirectory & strTargetFile)
Else
 
'If Excel spreadsheet "Test.PPT" is already open, set objPPT to point as "Test.PPT"
Set objPPT = objPPTApp.Presentations.Item(strDirectory & strTargetFile)
End If
 
End Sub
'This Function checks if the specific PowerPoint file is open
Function IsPPTOpen(strTargetFile As String) As Boolean 'The Default Value of Boolean is "FALSE"
    Dim i As Long
    'Count all the existing PowerPoint files open backwards, and
    For i = objPPTApp.Presentations.Count To 1 Step -1
        'If file name = the file of interest
        If objPPTApp.Presentations(i).Name = strTargetFile Then
            'Set function boolean to "TRUE"
            IsPPTOpen = True
        End If
    Next i
End Function
Sub DeletePowerPTPictures()
 
Set objPPTPres = objPPT
Set objPPTSlides = objPPTPres.Slides
 
Dim lngShapesCount As Long
Dim lngSlidesCount As Long
    
'For Each slides use this link http://www.ozgrid.com/forum/showthread.php?t=52682
 
'Counting how many slides in PowerPoint backwards to the 2nd slide
For lngSlidesCount = objPPTSlides.Count To 2 Step -1
    'Counting how many shapes are on each PowerPoint slide (one at a time)
    For lngShapesCount = objPPTSlides(lngSlidesCount).Shapes.Count To 1 Step -1
        'For each slides's shapes
        With objPPTSlides(lngSlidesCount).Shapes(lngShapesCount)
            'If any shape matches type "13" or "msoPicture",
            If .Type = msoPicture Then
                'delete and go to next shape then slide
                .Delete
            End If
        End With
    Next lngShapesCount
Next lngSlidesCount
 
     
End Sub
Sub SelectExcelRange()
 
Call OpenPowerPoint
Call OpenPPTFile
Call DeletePowerPTPictures
 
Set rngPage1 = sht1.Cells(3, 3).Resize(24, 17)
Set rngPage2 = sht2.Cells(3, 3).Resize(31, 17)
Set rngPage3 = sht3.Cells(3, 3).Resize(31, 9)
Set rngPage4 = sht4.Cells(3, 3).Resize(25, 9)
Set rngPage5 = sht5.Cells(3, 3).Resize(26, 8)
 
Dim arrPages()
ReDim arrPages(1 To 5)
 
arrPages(1) = rngPage1
arrPages(2) = rngPage2
arrPages(3) = rngPage3
arrPages(4) = rngPage4
arrPages(5) = rngPage5
 
'This method works
'rngPage1.CopyPicture xlScreen, xlPicture
'Set objPPTSlide = objPPTPres.Slides(2)
'objPPTSlide.Shapes.Paste
 
'This method doesn't work, I'm trying to loop it
Dim i As Long
For i = 1 To 5
   With arrPages(i)
      Cells.CopyPicture xlScreen, xlPicture 'Not the right way since it takes all the cells.
    End With
Set objPPTSlide = objPPTPres.Slides.Range(i + 1)
objPPTSlide.Shapes.Paste
Set objPPTSlide = Nothing
Next i
 
End Sub

           
         

	Title
1	Convert Excel data to Powerpoint usin…
2	PowerPoint 2003 VBA - shape na…
3	vba automation between Excel and Po…
4	Powerpoint Automation
5	Copying PowerPoint Slides without usi…
6	cannot hide powerpoint when manipul…

VBA - How to store excel range variables into an array and paste into PowerPoint

Asked by Shino_skay in Visual Basic v1.0.5.x, Microsoft Excel Spreadsheet Software, Microsoft Powerpoint Presentation Software

Tags: VBA, Excel, PowerPoint

About this solution