So I have a working Macro that copies Excel rows as pictures, and pastes each picture in a new PowerPoint slide.
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. 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.
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"). You can google how to add a new slide from a custom layout. 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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.