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

我在Excel中有特定列的名称，我想将其复制并粘贴到PowerPoint中，但我无法运行代码，因为我得到了“run Error 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） 您不能
设置Rng=[任何内容]。请选择
。您需要执行
设置Rng=[任何]
然后
Rng。在新行上选择
，但更重要的是

2） 最好是去。虽然你似乎没有在其他地方使用它（很好！），所以我打赌这只是一个“打字错误”

此外，如果您需要这些列，则可以执行以下操作：

Set rng = ThisWorkbook.ActiveSheet.Range("b3,f3,l3,n3,p3,q3").EntireColumn

编辑：这并不能解决粘贴中间列的问题，但这段代码（承认有点笨拙）将只选择所使用的数据（包括标题），而不是整个列：

 'Copy Range from Excel
  Dim lastRow As Long
  With ThisWorkbook.ActiveSheet

    lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
    ' I assume your headers actually are in row 3, and the data is in row 4 on ward:
    Set rng = ThisWorkbook.ActiveSheet.Range("b3:B" & lastRow & ",f3:F" & lastRow & ",l3:l" & lastRow & ",n3:N" & lastRow & ",p3:P" & lastRow & ",q3:Q" & lastRow)
    Set rng1 = ThisWorkbook.ActiveSheet.Range("G4:I4")
  End With
 'Create an Instance of PowerPoint
  On Error Resume Next
 ' Etc. etc.

取下
。选择

1） 您不能
设置Rng=[任何内容]。请选择
。您需要执行
设置Rng=[任何]
然后
Rng。在新行上选择
，但更重要的是

2） 最好是去。虽然你似乎没有在其他地方使用它（很好！），所以我打赌这只是一个“打字错误”

此外，如果您需要这些列，则可以执行以下操作：

Set rng = ThisWorkbook.ActiveSheet.Range("b3,f3,l3,n3,p3,q3").EntireColumn

编辑：这并不能解决粘贴中间列的问题，但这段代码（承认有点笨拙）将只选择所使用的数据（包括标题），而不是整个列：

 'Copy Range from Excel
  Dim lastRow As Long
  With ThisWorkbook.ActiveSheet

    lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
    ' I assume your headers actually are in row 3, and the data is in row 4 on ward:
    Set rng = ThisWorkbook.ActiveSheet.Range("b3:B" & lastRow & ",f3:F" & lastRow & ",l3:l" & lastRow & ",n3:N" & lastRow & ",p3:P" & lastRow & ",q3:Q" & lastRow)
    Set rng1 = ThisWorkbook.ActiveSheet.Range("G4:I4")
  End With
 'Create an Instance of PowerPoint
  On Error Resume Next
 ' Etc. etc.

嗨，布鲁斯！非常感谢你的快速回答。！这成功了！我刚取下“.Select”，没有更多的错误。然而，它粘贴了来自（“b3:q3”）的所有列，即使我选择了特定的列（“b3、f3、l3、n3、p3、q3”）。你知道这是为什么吗？@NicoleP我对PowerPoint中的VBA不太熟悉，但您在代码中的何处粘贴列？是否在这里，
mySlide.Shapes.PasteSpecial数据类型：=7
？是！到那张幻灯片。@NicoleP.-嗯，真奇怪。与那个问题没有太大关系，但我怀疑你是否真的需要/想要复制整个专栏，对吗？每列中的数据量是否相同（数据的行数是否相同），或者一行的信息是否比其他行多？这是正确的。我不想复制“整个列”，我只想要那些列的标题（所以只有一行，第3行）。我在每一列中都有相同数量的数据。所有行的数据量都相同。数据是文本。我的手机里没有任何号码。对于我的代码的整个范围。我试图只复制幻灯片上excel表格的标题，然后我将编写一个代码，循环遍历每一行，并将数据粘贴到标题下。我肯定对Excel VBA有点熟悉，但PowerPoint让它变得更难。嗨，布鲁斯！非常感谢你的快速回答。！这成功了！我刚取下“.Select”，没有更多的错误。然而，它粘贴了来自（“b3:q3”）的所有列，即使我选择了特定的列（“b3、f3、l3、n3、p3、q3”）。你知道这是为什么吗？@NicoleP我对PowerPoint中的VBA不太熟悉，但您在代码中的何处粘贴列？是否在这里，
mySlide.Shapes.PasteSpecial数据类型：=7
？是！到那张幻灯片。@NicoleP.-嗯，真奇怪。与那个问题没有太大关系，但我怀疑你是否真的需要/想要复制整个专栏，对吗？每列中的数据量是否相同（数据的行数是否相同），或者一行的信息是否比其他行多？这是正确的。我不想复制“整个列”，我只想要那些列的标题（所以只有一行，第3行）。我在每一列中都有相同数量的数据。所有行的数据量都相同。数据是文本。我的手机里没有任何号码。对于我的代码的整个范围。我试图只复制幻灯片上excel表格的标题，然后我将编写一个代码，循环遍历每一行，并将数据粘贴到标题下。我肯定对Excel VBA更熟悉一些，但PowerPoint让它变得更难。