PDA

View Full Version : Need help exporting row data in excel to their own individual powerpoint slide.



BRUCED83
07-25-2017, 05:54 AM
Can someone help me create the macro to do this.
Here is an idea of the kind of data I need from excel to be presented in a powerpoint slide. the top row is the title to each column.
NOT SURE IF THE module should be in excel or powerpoint too.






SKU:

MODEL:

MFG:

MFG2:

ORDERS:

QTY 1:

QTY 2:

QTY 3:

QTY 4:




123456789

PAODD

NAME 1

NAME 2

123

62

12

13

15




234567890

PAOZZ

NAME 1

NAME 2

245

78

14

16

20




345678912

PAZZZ

NAME 1

NAME 2

300

50

10

8

7




















Here is how I would like the data to look in powerpoint, if it can't look like this, I would like the data to at least show up in their specific slides and I can format later.

SLIDE 1 would be all of row 2 data SINCE row 1 is all column title data:
top of slide
19858bottom of slide

SLIDE 2 (row 3 data) & SLIDE 3 (row 4) would follow.

I would like to know if this is even possible. way beyond my knowledge of VBA so any help would be much appreciated.

mdmackillop
07-25-2017, 08:01 AM
Don't know much about PPT VBA so this is a bit crude

Option Explicit
Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range To The Active PowerPoint Slide
'SOURCE: Most of it: www.TheSpreadsheetGuru.com (http://www.TheSpreadsheetGuru.com) - few modifications: Me. :-)
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim pptLayout, x
Dim mySlide As Object
Dim myShape As Object
Dim Message As String
Dim Title As String
Dim Default As String
Dim myValue As String
Dim Typ As String
Dim MyData As Range, cel As Range


Set MyData = Sheets("Data").Columns(1).SpecialCells(2, 1)


On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Open Presentation
Set myPresentation = PowerPointApp.presentations.Add(msoTrue)
myPresentation.Slides.Add Index:=myPresentation.Slides.Count + 1, Layout:=1
For Each cel In MyData.Cells
Sheets("Output").Range("B1").Value = cel.Value
Set rng = Sheets("Output").Range("A1:F6")
'Copy Excel Range
rng.Copy
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
x = PowerPointApp.ActivePresentation.Slides.Count
Set mySlide = PowerPointApp.ActivePresentation.Slides(x)
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2= ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 66
myShape.Top = 152
'Clear The Clipboard
Application.CutCopyMode = False
If x = MyData.Cells.Count Then Exit Sub
myPresentation.Slides.Add Index:=myPresentation.Slides.Count + 1, Layout:=1
Next cel
End Sub