Question

我尝试使用VBA将我从excel复制的图表移动到powerpoint中。代码如下。不知道为什么它不起作用。你们怎么接近它？我尝试了很多不同的方法，包括插入＆＃34; .select＆＃34;在＆＃34; .paste＆＃34;之后但是它给了我错误。真的不确定... = \任何帮助表示赞赏。

`

＆＃13;

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

＆＃13;

`

Answer 1

我在这里包含了两个程序 - 一个将创建一个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

如果您在工作表上放置多个图表，则可能需要将Top和Left值作为变量。

如果lTop是一个代表顶部位置的长度 - 将其放在计算下一个顶部值相对于当前选择的位置。

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

注意：此副本会粘贴您的范围/图表的图片，而不是实际的范围/图表对象。

将图表从excel移动到powerpoint后无法移动图表!! d：

1 个答案: