文章/答案/技术大牛

发布

社区首页 >问答首页 >不能将图表从excel移动到powerpoint！D：

问不能将图表从excel移动到powerpoint！D：
EN

Stack Overflow用户

提问于 2015-06-11 17:10:40

回答 1查看 864关注 0票数 0

我正在尝试使用VBA将我从excel复制到powerpoint的图表。密码在下面。不知道为什么不行。你们怎么接近它？我尝试过许多不同的方法，包括在".select“之后插入".paste”，但这会给我带来错误。真的不确定..。任何帮助都是非常感谢的。

`

Sub Automating_PowerPoint_from_Excel_1()
'Automate using Early Binding: Add a reference to the PowerPoint Object Library in Excel (your host application) by clicking Tools-References in VBE, which will enable using PowerPoint's predefined constants. Once this reference is added, a new instance of PowerPoint application can be created by using the New keyword.

'Create a new PowerPoint ppt of 3 slides with sound effect, and run a slide show.
 
'variables declared as a specific object type ie. specific to the application which is being automated:
Dim applPP As PowerPoint.Application
Dim prsntPP As PowerPoint.Presentation
Dim slidePP As PowerPoint.Slide
Dim shapePP As PowerPoint.Shape
Dim lSlideCount As Long
Dim strPpPath As String, strPpName As String
Dim oSh As Shape

'Create a new instance of the PowerPoint application. Set the Application object as follows:
Set applPP = CreateObject("Powerpoint.Application")

'make the PowerPoint window visible:
applPP.Visible = True
'maximize PowerPoint window:
applPP.WindowState = ppWindowMaximized
applPP.Presentations.Open "C:\Users\....\Template A Powerpoint.pptx"

Set prsntPP = applPP.ActivePresentation

'-------------------------


ActiveWorkbook.Sheets("...").ChartObjects(4).Activate
    ActiveChart.ChartArea.Copy
prsntPP.Slides(3).Shapes.Paste

vba

powerpoint

excel

回答 1

Stack Overflow用户

发布于 2015-06-12 12:10:33

我在这里包含了两个过程-一个将创建powerpoint的实例，另一个将复制图表、范围并向文本框中添加一些文本。

注:我还没有完全测试过，只是把它从我正在做的项目中拿出来了。

Public Sub UpdatePowerPoint()

    Dim oPPT As Object
    Dim oPresentation As Object
    Dim oSlide As Object
    Dim cht As Chart
    Dim lTop As Long

    On Error GoTo ERROR_HANDLER

    Set oPPT = CreatePPT

    ''''''''''''''''''''''''''''''''
    'Update path to your template. '
    ''''''''''''''''''''''''''''''''
    Set oPresentation = oPPT.Presentations.Open( _
        "S:\Bartrup-CookD\PowerPoint Template.pptx")
    oPPT.ActiveWindow.ViewType = 1 ' 1 = ppViewSlide

    '''''''''''''''''''''''''''''''''''''''''''
    'Add some text to a placehold on slide 1. '
    '''''''''''''''''''''''''''''''''''''''''''
    oPresentation.Windows(1).View.GoToSlide 1
    With oPresentation.Slides(1)
        .Shapes.PlaceHolders(1).Select msoTrue
        .Shapes.PlaceHolders(1).TextFrame.TextRange.Text = _
            "Add the date to this text box " & vbCr & _
            Format$(Date, "mmmm yyyy")
    End With

    ''''''''''''''''''''''''''''''''''''
    'Add a chart and range to slide 2. '
    ''''''''''''''''''''''''''''''''''''
    oPresentation.Windows(1).View.GoToSlide 2
    With oPresentation.Slides(2)

        '''''''''''''''''''''''''''
        'Copy and paste the chart '
        '''''''''''''''''''''''''''
        .Select
        Set cht = ThisWorkbook.Worksheets("Sheet1").ChartObjects("MyChart").Chart
        cht.CopyPicture Appearance:=xlScreen, Format:=xlPicture, Size:=xlScreen
        .Shapes.Paste.Select
        oPresentation.Windows(1).Selection.ShapeRange.Left = 40
        oPresentation.Windows(1).Selection.ShapeRange.Top = 90

        '''''''''''''''''''''''''''''''''
        'Copy and paste the data range. '
        '''''''''''''''''''''''''''''''''
        ThisWorkbook.Worksheets("Sheet1").Range("A2:F5").CopyPicture Appearance:=xlScreen, Format:=xlPicture
        .Shapes.Paste.Select
        oPresentation.Windows(1).Selection.ShapeRange.Left = 40
        oPresentation.Windows(1).Selection.ShapeRange.Top = 90

    End With

End Sub

Public Function CreatePPT(Optional bVisible As Boolean = True) As Object

    Dim oTmpPPT As Object

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case PowerPoint is not running. '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oTmpPPT = GetObject(, "PowerPoint.Application")

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of PowerPoint. '
    'Reinstate error handling.                                 '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo ERROR_HANDLER
        Set oTmpPPT = CreateObject("PowerPoint.Application")
    End If

    oTmpPPT.Visible = bVisible
    Set CreatePPT = oTmpPPT

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreatePPT."
            Err.Clear
    End Select

End Function

如果您要在一张表上放置多个图表，您可能希望将顶部和左边的值作为变量。

如果lTop是一个长的代表顶部位置的位置，这将计算下一个与当前选择相关的最高值。

lTop = lTop + oPresentation.Windows(1).Selection.ShapeRange.Height + 20

注:复制并粘贴一张您的范围/图表的图片，而不是实际的范围/图表对象。

票数 0

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/30787224

复制

相似问题

问不能将图表从excel移动到powerpoint！D：
EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问不能将图表从excel移动到powerpoint！D：EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问不能将图表从excel移动到powerpoint！D：
EN