Updating a PPT presentation with data from Excel..

[beenman]

Hi,

I've put together a macro for PPT that updates the presentation with data from excel.

But I've come across a problem that I can't seem to solve.
The macro only works when the charts are of embedded type..
So the question is, how do I get the macro to figure out what type of charts are there and then use an appropriate method to update them?

Just to be clear, the excel file that is opened has the slide numbers in column 2 and the range to be copied starting on the same row but in column 3.

The code I've got is below:



Sub Update_PPT_From_XL()

' Dim variables
Dim xlApp As Excel.Application
Dim xlFile As Excel.Workbook
Dim xlSheetTabell As Excel.Worksheet
Dim xlIndata As Excel.Range
Dim Rubrik As String
Dim oText As Shape
Dim Area As Excel.Range

' Open/Show Excel
Set xlApp = New Excel.Application
xlApp.Visible = msoCTrue

Dim FilBox As FileDialog
Dim Filename As String

Set FilBox = Application.FileDialog(Type:=msoFileDialogFilePicker)
FilBox.Show
Filename = Application.FileDialog(Type:=msoFileDialogFilePicker).SelectedItems.Item(1)

Dim MyNote As String
Dim Answer As String

'Place your text here
MyNote = "Create new slides?"

'Display MessageBox
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Template")

' Open XL data file
Set xlFile = xlApp.Workbooks.Open(Filename)
Set xlSheetTabell = xlFile.Worksheets(1)

Dim LastRow As Long
Dim rr As Long
Dim WorkRow As Long
Dim SlideNumber As Long

LastRow = xlSheetTabell.Cells(1000000, 2).End(xlUp).Row
rr = xlSheetTabell.Range("B1").End(xlDown).Row

Do Until rr > LastRow

SlideNumber = xlSheetTabell.Cells(rr, 2).Value
Rubrik = Cells(rr, 3).Value

Debug.Print rr; SlideNumber; Rubrik

xlSheetTabell.Cells(rr, 3).Select
xlSheetTabell.Range(Selection, Selection.End(xlToRight)).Select
xlSheetTabell.Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Dim c As Long
Dim r As Long
Dim Column As String

c = Selection.Columns.Count
r = Selection.Rows.Count

'Copy data to PPT
'---------------------------------------------
Dim oPPTShape As Shape
Dim a2 As Excel.Range

ActivePresentation.Slides(SlideNumber).Select

Set oText = ActivePresentation.Slides(SlideNumber).Shapes.Title
' oText.TextFrame.TextRange.Text = Rubrik

Set oPPTShape = ActivePresentation.Slides(SlideNumber).Shapes(2)
Set oxl = oPPTShape.OLEFormat.Object
Set xchart = oxl.Charts(1)
Set xlSheet = oxl.Worksheets("Blad1")
xlSheet.Range("a1").PasteSpecial xlPasteValues

Set a2 = Range(Cells(1, 1), Cells(r, c))

xchart.SetSourceData Source:=xlSheet.Range(a2.Address), PlotBy:=xlRows
xchart.Activate

'---------------------------------------------

oxl.Save

Set xlSheet = Nothing
Set xchart = Nothing
Set oxl = Nothing

If Answer = vbYes Then
ActivePresentation.Slides(SlideNumber).Duplicate
End If

rr = xlSheetTabell.Range("B" & rr).End(xlDown).Row

Loop

Dim Sistabilden As Long
Sistabilden = ActivePresentation.Slides.Count

If Answer = vbYes Then
ActivePresentation.Slides(Sistabilden).Delete
End If

xlSheetTabell.Range("B1").Copy
xlFile.Close
xlApp.Quit

Dim dlgSaveAs As FileDialog
Dim Savename

Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
dlgSaveAs.Show

Savename = Application.FileDialog(msoFileDialogSaveAs).SelectedItems.Item(1)
ActivePresentation.SaveAs Filename:=Savename

End Sub




It works fine when the charts are embedded, but I get an error in the copy to PPT part when they are of the other format...

Another very strange thing that happens when I run the code line by line, is that it messes up the charts in the paste part, don't understand why...

Any help much appreciated!

Regards
Beenman