简体   繁体   English

使用VBA将Excel数据复制到精确的PowerPoint幻灯片单元格

[英]Copy Excel data to exact PowerPoint slide cell using VBA

So I have a working Macro that copies Excel rows as pictures, and pastes each picture in a new PowerPoint slide. 因此,我有一个工作的宏,它将Excel行复制为图片,并将每张图片粘贴到新的PowerPoint幻灯片中。

So my job now is to to take individual data from an exact cell (for example A1, D1, H1, X1) and paste it in a predefined PowerPoint slide layout. 因此,我现在的工作是从确切的单元格中获取单个数据(例如A1,D1,H1,X1)并将其粘贴到预定义的PowerPoint幻灯片布局中。 So each cell goes to its corresponding place in the slide layout. 因此,每个单元格都将转到幻灯片布局中的相应位置。 I think only a bit of modifying is needed but I have absolutely no clue what to do. 我认为只需要一点修改,但是我绝对不知道该怎么做。 I'm really quite new with VBA so all help is appreciated. 我对VBA真的很陌生,因此感谢所有帮助。

Thank you for your time and have a great day! 谢谢您的时间,祝您度过愉快的一天! :) :)

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

You could create a custom layout with text boxes in the positions you want the cells. 您可以在所需单元格的位置使用文本框创建自定义布局。 The text inside the text boxes can be used to identify them (eg "mybox1"). 文本框内的文本可用于标识它们(例如“ mybox1”)。 You can google how to add a new slide from a custom layout. 您可以通过Google搜索如何从自定义布局添加新幻灯片。 Then search through the shapes and paste the cells in the same locations. 然后搜索形状并将单元格粘贴到相同的位置。 Something like this: 像这样:

'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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM