请选择 进入手机版 | 继续访问电脑版
查看: 227|回复: 0

[.NET开发] VBA粘贴Excel选定工作表范围到活动的PowerPoint幻灯片中(PowerPoint VBA)

3万

主题

3万

帖子

10万

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
100197
发表于 2015-11-23 17:52:02
这一程序 从一个 工作表中 复制选定的 工作表 区域作为一个 图片 然后 粘贴到 活动的 幻灯片 演示文稿中
  1. Sub RangeToPresentation()
  2. ' Set a VBE reference to Microsoft Excel Object Library
  3. Dim XLApp As Excel.Application
  4. Dim PPSlide As Slide
  5. ' Reference existing instance of Excel
  6. Set XLApp = GetObject(, "Excel.Application")
  7. ' Make sure a range is selected
  8. If Not TypeName(XLApp.Selection) = "Range" Then
  9. MsgBox "Please select a worksheet range and try again.", _
  10. vbExclamation, "No Range Selected"
  11. Else
  12. ' Can only paste into slide view
  13. Application.ActiveWindow.ViewType = ppViewSlide
  14. ' Reference active slide
  15. Set PPSlide = ActivePresentation.Slides _
  16. (Application.ActiveWindow.Selection.SlideRange.SlideIndex)
  17. ' Copy the range as a piicture
  18. XLApp.Selection.CopyPicture Appearance:=xlScreen, _
  19. Format:=xlPicture
  20. ' Paste the range
  21. PPSlide.Shapes.Paste.Select
  22. ' Align the pasted range
  23. Application.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
  24. Application.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
  25. ' Clean up
  26. Set PPSlide = Nothing
  27. End If
  28. Set XLApp = Nothing
  29. End Sub
复制代码
  1. Private Sub PasteToPPT(PPApp As Powerpoint.Application, PPPres As Powerpoint.Presentation, ByRef RefSh As Powerpoint.Shape, idx As Integer, leftPosition As Single, topPosition As Single, widthSize As Single, heightSize As Single)
  2. Dim PPSlide As Powerpoint.Slide
  3. 'Get specified the slide to add excel table
  4. Set PPSlide = PPPres.Slides(idx)
  5. With PPApp.ActiveWindow
  6. .View.GotoSlide idx
  7. .View.Paste
  8. With .Selection.ShapeRange
  9. .LockAspectRatio = msoFalse
  10. .Left = leftPosition
  11. .Top = topPosition
  12. .Width = widthSize
  13. .Height = heightSize
  14. End With
  15. End With
  16. End Sub
复制代码


回复

使用道具 举报