使用VBA从Excel复制并粘贴到PowerPoint

时间:2019-03-18 16:09:20

标签: excel vba powerpoint

我在Excel中有特定的列名称,我想要复制并粘贴到PowerPoint中,但是由于出现“运行错误424”,所以我无法运行代码。我已经尝试过使用(“ B3:Q3”)的列,并且有效。但是,我不需要所有这些列,只希望下面列出的列(“ b3,f3,l3,n3,p3,q3”)。 有人可以协助吗?非常感谢!

Sub ExcelRangeToPowerPoint()

Dim rng As Range
Dim rng1 As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object

'Copy Range from Excel
  Set rng = ThisWorkbook.ActiveSheet.Range("b3,f3,l3,n3,p3,q3").Select 'THIS IS THE ERROR
  Set rng1 = ThisWorkbook.ActiveSheet.Range("G4:I4")

'Create an Instance of PowerPoint
  On Error Resume Next

    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")

    'Clear the error between errors
      Err.Clear

    'If PowerPoint is not already open then open PowerPoint
      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")

    'Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If

  On Error GoTo 0

'Optimize Code
  Application.ScreenUpdating = False

'Create a New Presentation
  Set myPresentation = PowerPointApp.Presentations.Add

'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly

'Copy Excel Range
  rng.Copy

'Paste to PowerPoint and position
  mySlide.Shapes.PasteSpecial DataType:=7  '7 = ppPasteText
  Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

'Set position:rng
  myShape.Left = 70
  myShape.Top = 150
  myShape.Width = 800
  myShape.Height = 100

'Copy Excel Range
  rng1.Copy

'Paste to PowerPoint and position
  mySlide.Shapes.PasteSpecial DataType:=7  '7 = ppPasteText
  Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

'Set position:rng
  myShape.Left = 70
  myShape.Top = 200
  myShape.Width = 800
  myShape.Height = 300

'Insert the tile on the ppt
mySlide.Shapes.Title.TextFrame.TextRange.Text = "Insert Title Here"

'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub

1 个答案:

答案 0 :(得分:0)

起飞catchError()

1)您不能.pipe( catchError(error => { const responseHeader = error.headers.get('<header_name>'); if (responseHeader) { // send to /refresh-token route } }) ) 。您想换行.Select 然后 Set Rng = [whatever].Select,但更重要的是

2)最好Avoid using .Select/.Activate。尽管您似乎没有在其他地方使用它(很好!),所以我敢打赌,这只是一个“错别字”。

此外,如果您想要 Columns ,那么您可以这样做:

Set Rng = [whatever]

编辑:这不会解决在中间列之间粘贴的问题,但是此代码(一定有点笨拙)将仅选择所使用的数据(包括标题),而不是整个列:

Rng.Select