Copying Excel sheet to Powerpoint with VBA

  • Thread starter Thread starter RLN
  • Start date Start date
R

RLN

RE: Excel 2007/Powerpoint 2007

I have an Excel file with 30 tabs. Each tab has data and some
graphics (no charts though). The range on all tabs is from cell A1 to
Q50, although that can change with next months data. I would like to
transfer each of the 30 tabs to 30 slides in a single PPT deck. I got
a macro started to copy the data from the sheet, but am unsure how to
paste to PPT.

I need to:
1) copy each sheet in the above range and paste to an individual
slide.
2) position the paste to be in the upper left hand corner of the
slide.
3) expand the pasted object to "fit to slide"
4) take the title of each tab (ie "Tb3.1", Tb3.2", etc....) and put
those in the bottom right hand corner of the slide, say with a 10pt
Arial font.

Can this be done in VBA and if so, does anyone have a code sample
shell of how to do this?

many thanks,
 
RE: Excel 2007/Powerpoint 2007

I have an Excel file with 30 tabs.  Each tab has data and some
graphics (no charts though).  The range on all tabs is from cell A1 to
Q50, although that can change with next months data.  I would like to
transfer each of the 30 tabs to 30 slides in a single PPT deck.  I got
a macro started to copy the data from the sheet, but am unsure how to
paste to PPT.

I need to:
1) copy each sheet in the above range and paste to an individual
slide.
2) position the paste to be in the upper left hand corner of the
slide.
3) expand the pasted object to "fit to slide"
4) take the title of each tab (ie "Tb3.1", Tb3.2", etc....) and put
those in the bottom right hand corner of the slide, say with a 10pt
Arial font.

Can this be done in VBA and if so, does anyone have a code sample
shell of how to do this?

many thanks,
Click to expand...

Check out Jon Peltier's website (linked below). he has an awesome
page about using excel with other office applications.

http://peltiertech.com/Excel/XL_PPT.html
 
I used the code and it is awesome!! The only problem is when i want to copy the same chart with new data it copies over the previous chart. I need it to make a new slide with the new chart. I have modified the code to include a range. Here is the sample code please help!!

Sub Copy_Paste_to_PowerPoint()

'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE
Dim XLApp As Excel.Application
Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
Dim PPPres As PowerPoint.Presentation


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 = "A9:N43"
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.Width = 715
ppApp.ActiveWindow.Selection.ShapeRange.Top = 0
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
'ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True


AppActivate ("Microsoft PowerPoint")
Set ppSlide = Nothing
Set PPPres = Nothing
Set ppApp = Nothing
Set XLApp = Nothing

End Sub
 
Back
Top