【问题标题】:Copy Excel data to exact PowerPoint slide cell using VBA使用 VBA 将 Excel 数据复制到精确的 PowerPoint 幻灯片单元格
【发布时间】: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,或者在WithWith PPSlide.Shapes.Paste)中使用它,以便您可以更轻松地移动它

标签: vba excel copy powerpoint


【解决方案1】:

您可以在您想要的单元格位置创建带有文本框的自定义布局。文本框内的文本可用于识别它们(例如“mybox1”)。您可以谷歌如何从自定义布局添加新幻灯片。然后搜索形状并将单元格粘贴到相同的位置。像这样的:

'Paste
  For Each PPshape In PPslide.Shapes
    If PPshape.HasTextFrame Then
        If PPshape.TextFrame.HasText Then
            If PPshape.TextFrame.TextRange.Text = "mybox1" Then
                PPslide.Shapes.Paste.Select
                PP.ActiveWindow.Selection.ShapeRange.Left = PPshape.Left
                PP.ActiveWindow.Selection.ShapeRange.Top = PPshape.Top
                PPshape.Delete
            End If
        End If
    End If
Next PPshape

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2021-04-14
    • 1970-01-01
    • 2022-12-23
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2015-07-26
    相关资源
    最近更新 更多