Question

我正在尝试将表格和图表从一个工作表“帐户效果”复制到现有的powerpoint幻灯片编号。 2 下面提到的代码有三个问题：第一个问题，我写了两个代码来复制表（通过指定范围）另一个复制图表，但是当我运行代码时，表被粘贴在幻灯片上两次并且它没有粘贴图表。我做错了什么？第二个问题，为chartobject设置的位置代码给出了错误第三个问题，大多数时候代码没有给出错误，但有时代码在下面提到的行上给出了错误： pres.Slides（2）.Shapes.Paste

请在下面找到代码：

Sub latestppu()
  Dim pptapp As PowerPoint.Application
  Dim pres As PowerPoint.Presentation
  Dim preslide As PowerPoint.Slide
  Dim shapepp As PowerPoint.Shape
  Dim exappli As Excel.Application
  Dim exworkb As Workbook
  Dim rng As Range
  Dim myshape As Object
  Dim x As Integer

  x = 1

  Dim mychart As ChartObject
  Dim activechart As ChartObject
  Dim R As Integer
  Dim G As Integer
  Dim B As Integer

  'Open powerpoint application -
  Set exappli = New Excel.Application
  exappli.Visible = True

  'activate powerpoint application
  Set pptapp = New PowerPoint.Application

  pptapp.Visible = True
  pptapp.Activate

  'open the excel you wish to use

  Set exworkb = exappli.Workbooks.Open("C:\Users\astha.verma\Desktop\Macro\Reference Sheet.xlsm")


  'open the presentation you wish to use
  Set pres = pptapp.Presentations.Open("C:\Users\astha.verma\Desktop\Macro\PPTtemplate.pptx")

  'Add title to the first slide
  With pres.Slides(1)

    If Not .Shapes.HasTitle Then
       Set shapepp = .Shapes.AddTitle
    Else:
       Set shapepp = .Shapes.Title
    End If

    With shapepp
      .TextFrame.TextRange.Text = "Gulf+ Market Segment Analysis Report" & vbNewLine & "P5 Week 04 FY17"
      .TextFrame.TextRange.Font.Name = "Arial Black"
      .TextFrame.TextRange.Font.Size = 24
      .TextEffect.FontBold = msoTrue
      .TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
    End With
  End With

  'Add title to second slide
  With pres.Slides(2)
    If Not .Shapes.HasTitle Then
       Set shapepp = .Shapes.AddTitle
    Else:
       Set shapepp = .Shapes.Title
    End If

    With shapepp
      .TextFrame.TextRange.Text = "Gulf+ Account Performance"
      .TextFrame.TextRange.Font.Name = "EY Gothic Cond Demi"
      .TextFrame.TextRange.Font.Size = 22
      .TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
      .TextEffect.FontBold = msoFalse
      .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
      .TextEffect.Alignment = msoTextEffectAlignmentLeft
    End With
  End With

  'add a textbox

  Set shapepp = pres.Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=650, Top:=75, Width:=200, Height:=50)

  With shapepp
    .TextFrame.TextRange.Text = "Other Account Performance Metrics"
    .TextFrame.TextRange.Font.Name = "EY Gothic Cond Demi"
    .TextFrame.TextRange.Font.Size = 16
    .TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignRight
    .TextEffect.FontBold = msoTrue
    .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
  End With

  'Copy a table range from account summary worksheet and paste it in powerpoint slide 2:-

  'defining the range
  Set rng = exworkb.Sheets("Account Performance").Range("A1:B5")

  'Copy excel range
  rng.Copy

  'paste to powerpoint slide 2
  '**attimes gives error on this line(did I do anything wrong)**
  pres.Slides(2).Shapes.Paste

  pptapp.ActiveWindow.Selection.ShapeRange.Align msoAlignTops, msoTrue
  pptapp.ActiveWindow.Selection.ShapeRange.Top = -30
  pptapp.ActiveWindow.Selection.ShapeRange.Left = 350

  On Error Resume Next

  'add a textbox

  Set shapepp = pres.Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=600, Top:=280, Width:=200, Height:=50)

  With shapepp
    .TextFrame.TextRange.Text = "GTER by global account segment"
    .TextFrame.TextRange.Font.Name = "EY Gothic Cond Demi"
    .TextFrame.TextRange.Font.Size = 16
    .TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignRight
    .TextEffect.FontBold = msoTrue
    .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
  End With

  'defining the second  chart to be copied
  Set mychart = exworkb.Sheets("Account Performance").ChartObjects

  'Copy first chart
  mychart.Chart.ChartObjects.Copy

  'paste to powerpoint slide 2
  pres.Slides(2).Shapes.Paste

  'position?
  With pres.Slides(2).Shapes(1)
    .Top = 165
    .Left = 200
  End With

End Sub

Answer 1

Resume Next的问题在于它不仅可以帮助绕过您可能预期的错误，而且还可以绕过导致代码无效的错误。

我不知道下面的前两个命令是做什么的，但我认为它们充满了你不了解的错误（因为'defining the second chart to be copied Set mychart = exworkb.Sheets("Account Performance").ChartObjects 'Copy first chart mychart.Chart.ChartObjects.Copy 'paste to powerpoint slide 2 pres.Slides(2).Shapes.Paste），所以什么都没有复制。剪贴板仍然包含表格，以及粘贴的内容。

'define the chart to be copied
Set mychart = exworkb.Sheets("Account Performance").ChartObjects(1).Chart

'copy the chart
mychart.ChartArea.Copy

' inserted to help with timing errors
DoEvents

'paste to powerpoint slide 2
pres.Slides(2).Shapes.Paste

那么你为什么要谈论第一和第二张图表？

你应该将你的变量mychart声明为一个图表，然后将其正确地分配为图表（＆＃34;图表性能＆＃34中的哪些图表;是吗？我假设为1），然后复制它正常。

{{1}}

将图表和表格从Excel工作表复制到现有的powerpoint幻灯片2

1 个答案: