View Full Version : Powerpoint VBA Help Needed Please


graviz
12-18-2009, 08:30 AM
I need some assistance with automating some copying and pasteing from Excel to PowerPoint. I've search the forums for some help or examples and I am unable to find anything to help me with what I'm trying to accomplish. Here is what I am trying to do within Access using vba:

Autorun some queries: Done
Output it to an Excel spreadsheet in a certain range: Done
Copy a certain cell range in Excel and paste it in an existing PowerPoint on a certain slide as an enhance metafile using vba - This is what I need help on

I've seen some exmaples of pasting an Excel chart but nothing like that I'm trying to do.

noboffinme
01-31-2010, 04:23 PM
Hi graviz

Here's some code to do this & it uses a list of values you write into the cells in column 'A' of a worksheet to refer to a series of named ranges.

I've attached a Excel file to use with code, you will need to create a blank Powerpoint presentation for the macro to use. You need to reference the Powerpoint library to be used while this runs, to do this, go into the Visual Basic Editor & select the checkbox for Powerpoint 11.0 Object Library

So if you go to Excel & open the workbook, this code will paste them into Powerpoint.

This set up to paste from slide 2 to whatever number of the named ranges you add into column 'A' of the RANGE SHEETS worksheet.

--------------------------------------

Option Explicit
Public Filen, Filer As Variant
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Public c, d As Integer
Public chartname, A1 As String
Public Chart As Object
Public local_row As Long
Sub copy_range_to_ppt()
Dim wsname As String
Dim BaseTab As Variant
Dim openfile As Variant
Dim c, d As Integer
Dim Shapes As Object
Dim myrange As Range
'Define workbook variable name
Filen = ActiveWorkbook.Name
'Reference New PowerPoint Application
Set PPApp = New PowerPoint.Application

'Reference existing instance of PowerPoint
PPApp.Visible = True

'open an existing presentation
Set PPPres = PPApp.Presentations.Open("YOUR FILE PATH NAME.ppt")
'---------------------------------------
'Name your worksheet "RANGE SHEETS" or change this code to suit
'Newly selected workbook name
openfile = ActiveSheet.Name
BaseTab = "RANGE SHEETS"
Sheets(BaseTab).Select
Range("A2").Select

'This counts the number of rows with data in them
c = Application.CountA(Range("A1:A1000"))

'Begin the 'For........Next' loop
For d = 2 To c

'Select the worksheet containg the references to the CAGR tables
Sheets(BaseTab).Select

'Set the 'wsname' variable to the named range in the Cell selected
'below. Note 'D' is for Column 'D' & 'd' changes it's value each loop
'to select a new row
wsname = Range("A" & d).Value

'Go to the Named range located
Application.Goto Reference:=wsname

'Copy the range
Selection.Copy

'Reference New Application
Set PPApp = New PowerPoint.Application

'Reference active presentation
Set PPPres = PPApp.ActivePresentation

'Reference Powerpoint
Set PPApp = GetObject(, "Powerpoint.Application")

'Select the slide number = 'd'
PPPres.Slides(d).Select

'Reference active slide
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideInde x)

'Select the Format you need for pasting the Range
'comment the others out as you need

'Paste chart as Normal Picture
'PPSlide.Shapes.Paste

'Paste as Enhanced Metatfile
PPSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafil e).Select

'Paste as Bitmap
'PPSlide.Shapes.PasteSpecial(ppPasteBitmap).Select
'-------------------------

'Move table to the right if you need to change the position
PPApp.ActiveWindow.Selection.ShapeRange.IncrementL eft (255)

'Reset Powerpoint for the next loop
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

Next d

End Sub