1

我一直在使用 excel vba 使用下面的代码将 excel 文件中的图表复制并粘贴到 ppt 文件中。这是我在另一个应用程序中尝试过的代码，它运行良好，但我在另一个应用程序中使用了相同的代码，它抛出了错误将chart1粘贴到ppt时出现“应用程序定义或对象定义的错误”。谁能告诉我我做错了什么以及需要做哪些更改。

Sub PasteToPPT(FileName As String)
Dim file As String
file = FileName

Dim pptPres As PowerPoint.Presentation
Dim AppPPT As PowerPoint.Application
Dim SlidePPT As PowerPoint.Slide
Dim cht As Excel.ChartObject
Dim Sht As Excel.Sheets

Set AppPPT = CreateObject("PowerPoint.Application")
    AppPPT.Visible = True

     AppPPT.Presentations.Open (file)

     'AppPPT.Presentations.Open FileName:=file

     Excel.Sheets("Charts").Activate

     AppPPT.ActiveWindow.View.GotoSlide 1
        Set SlidePPT = AppPPT.ActivePresentation.Slides(1)

     Excel.Sheets("Charts").ChartObjects("Chart1").Copy '<-- Here i'm getting the error
         AppPPT.ActivePresentation.Slides(1).Shapes.Paste.Select

     AppPPT.ActiveWindow.Selection.ShapeRange.LockAspectRatio = False

    AppPPT.ActiveWindow.Selection.ShapeRange.Left = 0
    AppPPT.ActiveWindow.Selection.ShapeRange.Top = 275

    AppPPT.ActiveWindow.Selection.ShapeRange.Width = 966
    AppPPT.ActiveWindow.Selection.ShapeRange.Height = 200

    Excel.Sheets("Charts").ChartObjects("Chart2").Copy
        AppPPT.ActivePresentation.Slides(1).Shapes.Paste.Select

    AppPPT.ActiveWindow.Selection.ShapeRange.LockAspectRatio = False

    AppPPT.ActiveWindow.Selection.ShapeRange.Left = 0
    AppPPT.ActiveWindow.Selection.ShapeRange.Top = 390

    AppPPT.ActiveWindow.Selection.ShapeRange.Width = 966
    AppPPT.ActiveWindow.Selection.ShapeRange.Height = 200

    'AppPPT.ActivePresentation.SaveAs ("D:\Projects\IEB MBU MYR US\Demo_Slide.pptx")
    AppPPT.ActivePresentation.Save

    Set SlidePPT = Nothing
    ''AppPPT.Quit
    Set AppPPT = Nothing

End Sub

提前致谢。

4

1 回答 1

0

从 Dinesh 的评论中，如果有人后来偶然发现它，这是答案：

Sheets("Chart1")必须替换为Worksheets("Chart1")。

该Sheets集合仅包含真正的“计算”表 - 但该Worksheet集合还包含图表表（和 Excel4 宏表）。和Chart1图表一样，它没有包含在Sheets集合中......

于 2013-02-25T09:09:02.407 回答