-
Updating a PPT presentation with data from Excel..
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:
[VBA]
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
[/VBA]
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules