【发布时间】:2018-05-16 19:23:41
【问题描述】:
所以我有一个工作宏,可以将 Excel 行复制为图片,并将每张图片粘贴到新的 PowerPoint 幻灯片中。
所以我现在的工作是从精确的单元格(例如 A1、D1、H1、X1)中获取单个数据并将其粘贴到预定义的 PowerPoint 幻灯片布局中。因此,每个单元格都会转到幻灯片布局中的相应位置。我认为只需要进行一些修改,但我完全不知道该怎么做。我对 VBA 非常陌生,因此感谢所有帮助。
感谢您的宝贵时间,祝您有美好的一天! :)
Sub CopyRangeToPresentation()
'Variables
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
Dim PPslide As PowerPoint.Slide
Dim SlideTitle As String
Dim lRow As Long
Dim i As Integer
'Fider
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'New presentation
Set PP = New PowerPoint.Application
Set PPpres = PP.Presentations.Add
Set PP = GetObject(, "PowerPoint.Application")
PP.Visible = 1
For i = 1 To lRow
'New slide
Set PPslide = PPpres.Slides.Add(i, ppLayoutBlank)
PP.ActiveWindow.ViewType = ppViewSlide
PPpres.PageSetup.SlideSize = ppSlideSizeOnScreen
PP.ActiveWindow.WindowState = ppWindowMaximized
PPslide.Select
'Copy
Sheets("dataflows").Range(Cells(i, 1), Cells(i, 24)).CopyPicture _
Appearance:=xlScreen, Format:=xlPicture
'Paste
PPslide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
'Title
Next i
'Memory
PP.Activate
Set PPslide = Nothing
Set PPpres = Nothing
Set PP = Nothing
End Sub
【问题讨论】:
-
您发布的代码有什么问题?它与您的预期有何不同?我建议的一个小改动是使用(例如
Set PPShape = PPslide.Shapes.Paste)在对象中捕获PPslide.Shapes.Paste,或者在With(With PPSlide.Shapes.Paste)中使用它,以便您可以更轻松地移动它
标签: vba excel copy powerpoint