我正在尝试使用函数将图表从excel复制到PPT宏中的PPT。 虽然,当我尝试运行该函数时,它在下面的行上显示“下标超出范围”,我真的很困惑为什么。

Public dlgOpen As FileDialog
Public folder As String
Public excelApp As Object
Public xlWorkBook As Object
Public xlWorkBook2 As Object
Public PPT As Presentation
Public Name1 As String
Public Name2 As String
Public rng1 As Range
Public rng2 As Range
Dim NamedRange As Range


Public Sub GenerateVisual()
    Set PPT = ActivePresentation
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = True

    Set xlWorkBook = excelApp.workbooks.Open("C:\Users\wzawisa\Downloads\MarketSegmentTotals.xls")
    xlWorkBook.Sheets("MarketSegmentTotals").Activate
    xlWorkBook.ActiveSheet.Shapes.AddChart.Select
    xlWorkBook.ActiveChart.ChartType = xlColumnClustered
    xlWorkBook.ActiveChart.SetSourceData Source:=xlWorkBook.ActiveSheet.Range("MarketSegmentTotals!$A$1:$F$2")
    xlWorkBook.ActiveChart.Legend.Delete
    xlWorkBook.ActiveChart.SetElement (msoElementChartTitleAboveChart)
    xlWorkBook.ActiveChart.SetElement (msoElementDataLabelCenter)
    xlWorkBook.ActiveChart.ChartTitle.Text = "DD Ready by Market Segment"
    xlWorkBook.ActiveSheet.ListObjects.Add

    With xlWorkBook.ActiveChart.Parent
        .Top = 100    ' reposition
        .Left = 100   ' reposition
    End With

    Set xlWorkBook2 = excelApp.workbooks.Open("C:\Users\wzawisa\Downloads\GeneralTotals.xls")
    xlWorkBook2.Sheets("Totals").Activate
    xlWorkBook2.ActiveSheet.Shapes.AddChart.Select
    xlWorkBook2.ActiveChart.ChartType = xlColumnClustered
    xlWorkBook2.ActiveChart.SetSourceData Source:=xlWorkBook2.ActiveSheet.Range("Totals!$A$1:$C$2")
    xlWorkBook2.ActiveChart.Legend.Delete
    xlWorkBook2.ActiveChart.SetElement (msoElementChartTitleAboveChart)
    xlWorkBook2.ActiveChart.SetElement (msoElementDataLabelCenter)
    xlWorkBook2.ActiveChart.ChartTitle.Text = "Total DD Ready"
    xlWorkBook2.ActiveSheet.ListObjects.Add

    With xlWorkBook2.ActiveChart.Parent
        .Top = 100    ' reposition
        .Left = 100   ' reposition
    End With

    Set rng1 = xlWorkBook.Sheets("MarketSegmentTotals").Range("B8:F25")
    Set rng2 = xlWorkBook2.Sheets("Totals").Range("A8:C25")

    Call RangeToPresentation("MarketSegmentTotals", rng1)
    Call RangeToPresentation("Totals", rng2)

    'Set dlgOpen = Application.FileDialog(Type:=msoFileDialogFolderPicker)
    '
    'dlgOpen.Show
    'dlgOpen.Title = "Select Report Location"
    '
    'folder = dlgOpen.SelectedItems(1)

End Sub


Public Function RangeToPresentation(sheetName, NamedRange)
    Dim ppApp As Object
    Dim ppPres As Object
    Dim PPSlide As Object

    Set ppApp = GetObject(, "Powerpoint.Application")

    Set ppPres = ppApp.ActivePresentation
    ppApp.ActiveWindow.ViewType = ppViewNormal

    ' Select the last (blank slide)
    longSlideCount = ppPres.Slides.Count
    ppPres.Slides(1).Select

    Set PPSlide = ppPres.Slides(ppApp.ActiveWindow.Selection.SlideRange.SlideIndex)

    xlWorkBook.Sheets(sheetName).Range(NamedRange.Address).CopyPicture Appearance:=xlScreen, _
        Format:=xlBitmap

    ' Paste the range
    PPSlide.Shapes.Paste.Select

    'Set the image to lock the aspect ratio
    ppApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoTrue

    'Set the image size slightly smaller than width of the PowerPoint Slide
    ppApp.ActiveWindow.Selection.ShapeRange.Width = ppApp.ActivePresentation.PageSetup.SlideWidth - 10
    ppApp.ActiveWindow.Selection.ShapeRange.Height = ppApp.ActivePresentation.PageSetup.SlideHeight - 10

    'Shrink image if outside of slide borders
    If ppApp.ActiveWindow.Selection.ShapeRange.Width > 700 Then
        ppApp.ActiveWindow.Selection.ShapeRange.Width = 700
    End If

    If ppApp.ActiveWindow.Selection.ShapeRange.Height > 600 Then
        ppApp.ActiveWindow.Selection.ShapeRange.Height = 600
    End If

    ' Align the pasted range
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True    

    ' Clean up
    Set PPSlide = Nothing
    Set ppPres = Nothing
    Set ppApp = Nothing

End Function

#1楼 票数:1 已采纳

我认为你正在混合Range 请尝试下面发布的代码,其中包含原始代码的一些修改。 我在下面详细介绍了主要的。 您必须设置对Microsoft Excel vvv对象库的引用。 在VBE中,使用工具 - > 引用

主要变化:

  1. 声明Function的参数类型。

  2. Function更改为Sub (您只执行操作,不返回值)。

  3. 直接使用NamedRange 您不需要使用它的复杂方式。 第一个参数现在是多余的(你可以删除它)。

  4. 使用变量来引用对象。 这样可以更轻松地编码和调试。

  5. 删除了一些SelectActivate 除非严格要求,否则不应使用它们(显然不是这种情况)。

还有很多方面可以改进您的代码,特别是沿着上面的设置。 请先试试吧。 如果它不起作用,请使用调试器,监视器和即时窗口进行更深入的探索,并提供反馈。

Option Explicit

Public dlgOpen As FileDialog
Public folder As String
Public excelApp As Object
Public xlWorkBook As Excel.Workbook
Public xlWorkBook2 As Excel.Workbook
Public PPT As Presentation
Public Name1 As String
Public Name2 As String
Public rng1 As Excel.Range
Public rng2 As Excel.Range
Dim NamedRange As Excel.Range
Dim xlws As Excel.Worksheet
Dim xlsh As Excel.Shape
Dim xlch As Excel.Chart
Dim xlws2 As Excel.Worksheet
Dim xlsh2 As Excel.Shape
Dim xlch2 As Excel.Chart

Public Sub GenerateVisual()
    Set PPT = ActivePresentation
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = True

    Set xlWorkBook = excelApp.workbooks.Open("C:\Users\wzawisa\Downloads\MarketSegmentTotals.xls")
    Set xlws = xlWorkBook.Sheets("MarketSegmentTotals")
    Set xlsh = xlws.Shapes.AddChart
    Set xlch = xlsh.Chart
    With xlch
        .ChartType = xlColumnClustered
        .SetSourceData Source:=xlws.Range("$A$1:$F$2")
        .Legend.Delete
        .SetElement (msoElementChartTitleAboveChart)
        .SetElement (msoElementDataLabelCenter)
        .ChartTitle.Text = "DD Ready by Market Segment"
    End With
    xlws.ListObjects.Add

    With xlch.Parent
        .Top = 100    ' reposition
        .Left = 100   ' reposition
    End With

    Set xlWorkBook2 = excelApp.workbooks.Open("C:\Users\wzawisa\Downloads\GeneralTotals.xls")
    Set xlws2 = xlWorkBook.Sheets("Totals")
    'xlWorkBook2.Sheets("Totals").Activate
    Set xlsh2 = xlws2.Shapes.AddChart
    Set xlch2 = xlsh2.Chart
    With xlch2
        .ChartType = xlColumnClustered
        .SetSourceData Source:=xlws2.Range("$A$1:$C$2")
        .Legend.Delete
        .SetElement (msoElementChartTitleAboveChart)
        .SetElement (msoElementDataLabelCenter)
        .ChartTitle.Text = "Total DD Ready"
    End With
    xlWorkBook2.ActiveSheet.ListObjects.Add

    With xlws2.Parent
        .Top = 100    ' reposition
        .Left = 100   ' reposition
    End With

    Set rng1 = xlws.Range("B8:F25")
    Set rng2 = xlws2.Range("A8:C25")

    Call RangeToPresentation("MarketSegmentTotals", rng1)
    Call RangeToPresentation("Totals", rng2)

    'Set dlgOpen = Application.FileDialog(Type:=msoFileDialogFolderPicker)
    '
    'dlgOpen.Show
    'dlgOpen.Title = "Select Report Location"
    '
    'folder = dlgOpen.SelectedItems(1)

End Sub


Public Sub RangeToPresentation(ByVal sheetName As String, NamedRange As Excel.Range)
    Dim ppApp As Object
    Dim ppPres As Object
    Dim PPSlide As Object
    Set ppApp = GetObject(, "Powerpoint.Application")
    Set ppPres = ppApp.ActivePresentation
    ppApp.ActiveWindow.ViewType = ppViewNormal

    ' Select the last (blank slide)
    Dim longSlideCount As Integer
    longSlideCount = ppPres.Slides.Count
    ppPres.Slides(1).Select    
    Set PPSlide = ppPres.Slides(ppApp.ActiveWindow.Selection.SlideRange.SlideIndex)

    NamedRange.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    ' Paste the range
    PPSlide.Shapes.Paste.Select

    'Set the image to lock the aspect ratio
    ppApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoTrue

    'Set the image size slightly smaller than width of the PowerPoint Slide
    ppApp.ActiveWindow.Selection.ShapeRange.Width = ppApp.ActivePresentation.PageSetup.SlideWidth - 10
    ppApp.ActiveWindow.Selection.ShapeRange.Height = ppApp.ActivePresentation.PageSetup.SlideHeight - 10

    'Shrink image if outside of slide borders
    If ppApp.ActiveWindow.Selection.ShapeRange.Width > 700 Then
        ppApp.ActiveWindow.Selection.ShapeRange.Width = 700
    End If
    If ppApp.ActiveWindow.Selection.ShapeRange.Height > 600 Then
        ppApp.ActiveWindow.Selection.ShapeRange.Height = 600
    End If

    ' Align the pasted range
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

    ' Clean up
    Set PPSlide = Nothing
    Set ppPres = Nothing
    Set ppApp = Nothing

End Sub

  ask by Pablo translate from so

未解决问题?本站智能推荐:

1回复

尝试将Excel图表复制到Power Point演示时,下标超出范围错误

我正在尝试使用函数将图表从excel复制到PPT宏中的PPT。 虽然,当我尝试运行该函数时,它在下面的行上显示“下标超出范围”,我真的很困惑为什么。
1回复

在Excel中打开Power Point图表数据

我正在尝试创建一个宏以清理Powerpoint中图表后面的Excel工作表,以便仅存在图表中正在使用的数据,并且没有公式。 我拼凑了一下,当我在Excel中打开图表数据时可以正常工作,但是我希望可以创建一个宏来遍历工作簿中的每个图表,并为我打开Excel中的图表数据,以便我可以执行每个以下
1回复

Macro Excel不会将确切的图像粘贴到Powerpoint演示文稿中

我的Excel中的宏发生了最奇怪的事情。 它的工作原理就像一个魅力,但是当它必须复制2张图表并粘贴到我的PowerPoint演示文稿中时,突然之间,该图表并不完全相同。 我的代码: 它打开了另外5个工作簿...然后遍历一个循环,以复制所有图表 这很完美。 但是当我看一下
2回复

使用VBA将Excel图表复制到带有嵌入式数据的PowerPoint

从Excel中粘贴图表后,在图表的右下方弹出一个“智能标记”,从中可以选择“ Excel图表(整个工作簿)”(与默认的“图表”(链接到Excel)相对数据)”)。 这具有将数据嵌入图表中的效果,以便仍可以修改数据,但图表未链接到Excel文件。 有没有人能够使用VBA(在Excel-VBA或
1回复

将选择的Excel图表复制到PowerPoint中的位置

从Excel中,我需要打开PowerPoint模板,遍历每张幻灯片,并在占位符的备用文本字段中使用一些数据,将它们与Excel中的图表匹配,然后将其复制到PowerPoint幻灯片中的该位置。 搜索之后,我找到了一些代码,为了实现我的目标,我对其进行了修改。 它可以在Win7 Enter
1回复

将图表从Excel粘贴到特定布局中的特定占位符。 Powepoint 2010

我需要将多个图表从excel粘贴到powerpoint。 我发现了一些优秀的VBA代码(主要在Jon Peltier的网站上)。 现在我的powerpoint模板有许多布局(例如,1个图表占据大部分幻灯片或1个图表,幻灯片中有一个文本框等)。 我想要的是图表成为幻灯片布局的一部分,这样
2回复

将 Excel 图表复制/粘贴到 PowerPoint 错误

我正在尝试在 Excel 工作簿中获取 60 个图表并将它们粘贴到 PowerPoint。 在我们转换到 Office 365 之前它一直运行良好。现在我收到一个错误 指定的数据类型不可用 这是代码: 以前效果很好。 我尝试过ppPasteDefault和ppPasteEnhancedMe
2回复

在Powerpoint中在图表数据源中启用宏

我有一个包含许多图表的Powerpoint文件,我希望许多不同的用户可以使用它们自己的数据。 我试图通过将VBA写入每个数据源来使此Powerpoint尽可能易于使用(按数据源,我的意思是当您选择“插入”>“图表”时Powerpoint中嵌入的默认Excel工作表)。 我的目标是允许他
2回复

我想使用VBA将Excel中复制的单元格粘贴到PPT演示文稿中的图表数据中

我正在通过Excel编写宏,这将帮助我执行以下步骤。 目前,我处于第3步。 '在Excel工作表中复制特定的单元格 '打开现有的Powerpoint演示文稿(其中包含四张幻灯片,每张幻灯片上都有大约6-7张图表,其基础数据必须替换为复制的单元格) '选择幻灯片1上的特
1回复

将所有图表从Excel工作表复制到Powerpoint幻灯片

我已经建立了一个工作簿,以方便创建我所负责的月度报告演示文稿。 该工作簿有一些数据表,一些处理表,然后是编号表,其中包含我需要粘贴到相应幻灯片的图表。 到目前为止,我已经建立了VBA,用于打开PowerPoint模板并遍历每个excel工作表,并区分哪些工作表名称为数字,然后激活PowerP