使用VBA自动将文本框从Excel粘贴到PowerPoint

时间:2017-02-28 11:06:36

标签: vba excel-vba excel

我正在尝试调整自动将Excel图表转换为PowerPoint幻灯片的VBA脚本,然后创建空白文本框。

通过调整脚本,我还想复制工作表中的文本框并将其转换为PowerPoint幻灯片的文本框。请注意我每个图表只有一个文本框,因此它们始终是配对的。

脚本为available at this link,但我将其粘贴在此处以供参考:

Sub CreatePowerPoint()

 'Add a reference to the Microsoft PowerPoint Library by:
    '1. Go to Tools in the VBA menu
    '2. Click on Reference
    '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay

    'First we declare the variables we will be using
        Dim newPowerPoint As PowerPoint.Application
        Dim activeSlide As PowerPoint.Slide
        Dim cht As Excel.ChartObject

     'Look for existing instance
        On Error Resume Next
        Set newPowerPoint = GetObject(, "PowerPoint.Application")
        On Error GoTo 0

    'Let's create a new PowerPoint
        If newPowerPoint Is Nothing Then
            Set newPowerPoint = New PowerPoint.Application
        End If
    'Make a presentation in PowerPoint
        If newPowerPoint.Presentations.Count = 0 Then
            newPowerPoint.Presentations.Add
        End If

    'Show the PowerPoint
        newPowerPoint.Visible = True

    'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
        For Each cht In ActiveSheet.ChartObjects

        'Add a new slide where we will paste the chart
            newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
            newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
            Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

        'Copy the chart and paste it into the PowerPoint as a Metafile Picture
            cht.Select
            ActiveChart.ChartArea.Copy
            activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

        'Set the title of the slide the same as the title of the chart
            activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text

        'Adjust the positioning of the Chart on Powerpoint Slide
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125

            activeSlide.Shapes(2).Width = 200
            activeSlide.Shapes(2).Left = 700
            activeSlide.Shapes(2).Top = 125

        Next

    AppActivate ("Microsoft PowerPoint")
    Set activeSlide = Nothing
    Set newPowerPoint = Nothing

End Sub

我研究了如何将文本框与图表一起循环(使用Shapes Collection Object)但是没有用。

在这种情况下, For Each 循环可能不正确,因为我想循环两个元素,但我还没有找到使用 Do While Loop 为图表和文本框集合使用索引。

我相信一些简单易行的事情,但我对VBA的稀缺知识并没有帮助我。

提前致谢。

0 个答案:

没有答案