excel - 使用 VBA 从 Excel 复制和粘贴到 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
解决方案
脱掉.Select
。
1)你不能Set Rng = [whatever].Select
。你想Set Rng = [whatever]
在 Rng.Select
新的线路上做,但更重要的是,
2)最好避免使用.Select
/.Activate
。尽管您似乎没有在其他地方使用它(很好!),但我敢打赌这只是一个“错字”。
此外,如果你想要列,那么你会这样做:
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.
推荐阅读
- haskell - 理解haskell中的类型级函数
- python - Discord.py user.block/user.send_friend_request:错误 403/Forbidden 如何授予机器人发送好友请求和阻止用户的权限?
- c# - 在OpenGL中查找旋转矩阵
- java - Spring Sleuth - JMS ErrorHandler 上的跟踪中断
- c++ - 为什么用户无法提供他们的输入
- python - Python将带有argumnets的函数保存到变量而不调用函数
- reactjs - ComponentDidMount 在一个屏幕上工作,但在另一个屏幕上不起作用 - React-Native
- c++ - 如何为 C++ 构建 32 位的 Assimp 库?
- excel - 在 Excel 中为 SpinButton 分配键盘快捷键
- c# - Xamarin 表单 - ListView 选择问题