2011-06-15 76 views
4

我想從使用VBA的Excel(將數據粘貼到Powerpoint圖形對象後面的數據表中)中將數據轉換爲Excel中的Powerpoint圖形。使用VBA將數據從Microsoft Excel中的Microsoft Excel中獲取數據

我使用這個代碼爲例(source):

'Code by Mahipal Padigela 
'Open Microsoft Powerpoint,Choose/Insert a Graph type Slide(No.8), then double click to add a graph and click... 
'...outside the graph to close the Datasheet, then rename the Graph to "Mychart",Save and Close the Presentation 
'Open Microsoft Excel, add some test data to Sheet1(This example assumes that you have some test data... 
'...(numbers between 0-100) in Rows 2,3,4 and Columns B,C,D,E). 
'Open VBA editor(Alt+F11),Insert a Module and Paste the following code in to the code window 
'Reference 'Microsoft Powerpoint Object Library' (VBA IDE-->tools-->references) 
'Reference 'Microsoft Graph Object Library' (VBA IDE-->tools-->references) 
'Change "strPresPath" with full path of the Powerpoint Presentation created earlier. 
'Change "strNewPresPath" to where you want to save the new Presnetation to be created later 
'Close VB Editor and run this Macro from Excel window(Alt+F8) 

Dim oPPTApp As PowerPoint.Application 
Dim oPPTShape As PowerPoint.Shape 
Dim oPPTFile As PowerPoint.Presentation 
Public oGraph As Graph.Chart 
Dim SlideNum As Integer 

Sub PPGraphMacro() 
    Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String 
    strPresPath = "H:\PowerPoint\Presentation1.ppt" 
    strNewPresPath = "H:\PowerPoint\New1.ppt" 

    Set oPPTApp = CreateObject("PowerPoint.Application") 
    oPPTApp.Visible = msoTrue 
    Set oPPTFile = oPPTApp.Presentations.Open(strPresPath) 
    SlideNum = 1 
    oPPTFile.Slides(SlideNum).Select 
    Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Mychart") 
    Set oGraph = oPPTShape.OLEFormat.Object 

    Sheets("Sheet1").Activate 
    oGraph.Application.DataSheet.Range("A1").Value = Cells(2, 2).Value 
    oGraph.Application.DataSheet.Range("A2").Value = Cells(3, 2).Value 
    oGraph.Application.DataSheet.Range("A3").Value = Cells(4, 2).Value 
    oGraph.Application.DataSheet.Range("B1").Value = Cells(2, 3).Value 
    oGraph.Application.DataSheet.Range("B2").Value = Cells(3, 3).Value 
    oGraph.Application.DataSheet.Range("B3").Value = Cells(4, 3).Value 
    oGraph.Application.DataSheet.Range("C1").Value = Cells(2, 4).Value 
    oGraph.Application.DataSheet.Range("C2").Value = Cells(3, 4).Value 
    oGraph.Application.DataSheet.Range("C3").Value = Cells(4, 4).Value 
    oGraph.Application.DataSheet.Range("D1").Value = Cells(2, 5).Value 
    oGraph.Application.DataSheet.Range("D2").Value = Cells(3, 5).Value 
    oGraph.Application.DataSheet.Range("D3").Value = Cells(4, 5).Value 


    oGraph.Application.Update 
    oGraph.Application.Quit 

    oPPTFile.SaveAs strNewPresPath 
    oPPTFile.Close 
    oPPTApp.Quit 

    Set oGraph = Nothing 
    Set oPPTShape = Nothing 
    Set oPPTFile = Nothing 
    Set oPPTApp = Nothing 
    MsgBox "Presentation Created", vbOKOnly + vbInformation 
End Sub 

當我運行這個PPT打開就好了,然後代碼在停止:

Set oGraph = oPPTShape.OLEFormat.Object 

與錯誤消息「OLEFormat(未知成員):請求無效,此屬性僅適用於OLE對象。」

我使用Excel和PowerPoint 2010中

我在做什麼錯?我對這一切都很陌生,所以我認爲這很簡單。

謝謝

/吉米

+0

您的代碼在Excel 2003中正常運行...您有什麼版本?您是否設置了引用,並執行了代碼頂部的註釋中描述的所有其他內容?是否安裝了Microsoft Graph? – 2011-06-15 12:10:21

+0

@ Jean-FrançoisCorbett我正在使用Office 2010.所有引用都已設置,其他所有操作都已完成。這適用於例如:http://www.mahipalreddy.com/vba.htm#pptable 我需要安裝Microsoft Graph來執行此操作嗎? AFAIK我沒有安裝。 – 2011-06-15 12:20:10

回答

4

在PowerPoint 2010中做事情的新方法是創建一個Excel工作表,並將其鏈接到圖表的ChartData

如何做到這一點的一個例子在http://msdn.microsoft.com/en-us/library/ff973127.aspx給出,爲方便起見在下面轉載。

Sub CreateChart() 
    Dim myChart As Chart 
    Dim gChartData As ChartData 
    Dim gWorkBook As Excel.Workbook 
    Dim gWorkSheet As Excel.Worksheet 

    ' Create the chart and set a reference to the chart data. 
    Set myChart = ActivePresentation.Slides(1).Shapes.AddChart.Chart 
    Set gChartData = myChart.ChartData 

    ' Set the Workbook and Worksheet references. 
    Set gWorkBook = gChartData.Workbook 
    Set gWorkSheet = gWorkBook.Worksheets(1) 

    ' Add the data to the workbook. 
    gWorkSheet.ListObjects("Table1").Resize gWorkSheet.Range("A1:B5") 
    gWorkSheet.Range("Table1[[#Headers],[Series 1]]").Value = "Items" 
    gWorkSheet.Range("A2").Value = "Coffee" 
    gWorkSheet.Range("A3").Value = "Soda" 
    gWorkSheet.Range("A4").Value = "Tea" 
    gWorkSheet.Range("A5").Value = "Water" 
    gWorkSheet.Range("B2").Value = "1000" 
    gWorkSheet.Range("B3").Value = "2500" 
    gWorkSheet.Range("B4").Value = "4000" 
    gWorkSheet.Range("B5").Value = "3000" 

    ' Apply styles to the chart. 
    With myChart 
     .ChartStyle = 4 
     .ApplyLayout 4 
     .ClearToMatchStyle 
    End With 

    ' Add the axis title. 
    With myChart.Axes(xlValue) 
     .HasTitle = True 
     .AxisTitle.Text = "Units" 
    End With 

    'myChart.ApplyDataLabels 

    ' Clean up the references. 
    Set gWorkSheet = Nothing 
    ' gWorkBook.Application.Quit 
    Set gWorkBook = Nothing 
    Set gChartData = Nothing 
    Set myChart = Nothing 

End Sub 
+0

謝謝!我昨天發現了一些類似的東西,並使其工作,但它非常醜陋。這工作得很好,但。 – 2011-06-16 08:37:58

相關問題