Export Each Excel Row Text - to PPT

Good Morning folks and community :)

I am trying to export each Row of my excel file to PPT.

It has my descriptions of various technical bits and bobs, that needs to be presenter friendly.

Now I have got a head start thanks to Mr Tolley here.

http://www.craig-tolley.co.uk/2011/0...xcel-workbook/

Code:

---



Sub CreateSlides()

Found on Mr Tolley site

'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("C:\Users\DJ-PC\PartDescriptions.xlsm")

'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Set WS = OWB.Worksheets(1)
'Loop through each used row in Column A
For i = 1 To WS.Range("A65536").End(xlUp).Row
    'Copy the first slide and paste at the end of the presentation
    ActivePresentation.Slides(1).Copy
    ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)

    'Change the text of the first text box on the slide.
    ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value
Next

End Sub

---

I spent the whole day with various errors and what nots , so I overcame them, but I'm still not sure what to do - it runs - but no will it copy my row from excel into the power point.:igiveup:. I don't know why its playing so mean.



So to make it simple to understand


I have 2 Columns in Excel


Column A Part No - Column B - Description

PN384743 - This part belongs to the group TS234, Component CV2837 is required to .......etc


So each Row - would be a slide.


I would like to export each row into Excel as Text.

If any pro expert coder would not mind lending me their hand and helping me to solve this difficult case - I would be grateful very much

I would be really appreciative, as its not easy this coding - I can tell you:old:

thank you very much folks for your help, your time is valued. :grinhalo:


DJ

Code:

---

Sub M_snb()
  with getobject("C:\Users\DJ-PC\PartDescriptions.xlsm")
    sn = Sheets(1).Cells(1).CurrentRegion.Resize(, 2)
    .close 0
  end with
   
  With CreateObject("Powerpoint.application")
    With .presentations.Add
      For j = 1 To UBound(sn)
        With .Slides.Add(1, 12)
          With .Shapes.AddTextbox(1, 120, 120, 270, 100).TextFrame.TextRange
            .Text = sn(j, 1) & vbLf & sn(j, 2)
            .Font.Size = 38
          End With
        End With
      Next
    End With
  End With
End Sub

---

Hello snb,

and thank you very much for helping.:)

I ran this nice macro from PPT

error
sn = Sheets(1).Cells(1).CurrentRegion.Resize(, 2)


I run from excel - I get a new presentation with 1 slide - no text copied

what could it be - im not sure

thank you

DJ

There should be any data in cell A1 in sheets(1) of workbook C:\Users\DJ-PC\PartDescriptions.xlsm
You should comment out or remove 'option explicit'.
I forgot a dot:

Code:

---

Sub M_snb()
    With getobject("C:\Users\DJ-PC\PartDescriptions.xlsm")
        sn = .Sheets(1).Cells(1).CurrentRegion
        .close 0
    End With
   
    With CreateObject("Powerpoint.application")
        With .presentations.Add
            For j = 1 To UBound(sn)
                With .Slides.Add(1, 12)
                    With .Shapes.AddTextbox(1, 120, 120, 270, 100).TextFrame.TextRange
                        .Text = sn(j, 1) & vbLf & sn(j, 2)
                        .Font.Size = 38
                    End With
                End With
            Next
        End With
    End With
End Sub

---

Hello snb,

thank you very very much for fixing that code.:grinhalo:

I can't believe it - worked like a charm.

Saving me hours of copy pasting

Well done!!


I guess you have done the good job of solving this case

many thanks again:grinhalo:

DJ

You can condense the code to:

Code:

---

Sub M_snb()
    With getobject("C:\Users\DJ-PC\PartDescriptions.xlsm")
        sn = .Sheets(1).Cells(1).CurrentRegion
        .close 0
    End With
   
    With CreateObject("Powerpoint.application")
        With .presentations.Add
            For j = 1 To UBound(sn)
                With .Slides.Add(1, 12).Shapes.AddTextbox(1, 120, 120, 270, 100).TextFrame.TextRange
                  .Text = sn(j, 1) & vbLf & sn(j, 2)
                  .Font.Size = 38
                End With
            Next
        End With
    End With
End Sub

---

Thanks again snb,

I am happy to add this to my box of tools

Great man

you have a good day!:grinhalo:

dj

You migth even consider:

Code:

---

Sub M_snb()
  With getobject("C:\Users\DJ-PC\PartDescriptions.xlsm")
    sn = .Sheets(1).Cells(1).CurrentRegion
    .close 0
  End With
   
  With GetObject(, "Powerpoint.application")
    With .presentations.Add
      For j = 1 To UBound(sn)
        .slides.Add(1, 11).Shapes(1).TextFrame.TextRange = sn(j, 1) & vbLf & sn(j,2)
      Next
    End With
  End With
End Sub

---

snb,

you are being too kind and generous.:friends:

And not for me to take advantage of your good help, but I did have 1 questions - if you dont mind, otherwise I know I will get stuck again and have to post another thread:o:


1. Am I able to export into to existing PPT - I have found many nice templates online to showcase the parts description :type

You don't have to code for me as you have done so much - a point in the right direction i would be happy.

thank you snb

DJ

Actually I think I may be able to insert the images via the photo album, but it has a black background.

I also had the good fortune to find this little gem

Insert Images into PPT

http://www.pptfaq.com/FAQ00352_Batch..._per_slide.htm

worked a treat:grinhalo:

I'd use:

Code:

---

Sub M_snb()
    sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir G:\OF\*.jpg /b/s").stdout.readall, vbCrLf), ".")
   
    With GetObject(, "Powerpoint.application")
      With .presentations.Add
        For j = 0 To ubound(sn)
          .slides.Add(.slides.Count + 1, 12).Shapes.AddPicture sn(j), -1, -1, 10, 10
        Next
      End With
    End With
End Sub

---

Hi snb,

your code is working very nicely - it does the good job.:grinhalo:

I have been trying to export it to my existing PPT unsuccessfully,

Code:

---

Sub M_snb()
    With getobject("C:\Users\DJ-PC\PartDescriptions.xlsm")

 

        sn = .Sheets(1).Cells(1).CurrentRegion
        .close 0
    End With
   
    With CreateObject("Powerpoint.application")


    FlName = "C:\Users\DJ-PC\Desktop\DJPartDescriptions.PPTX"    ' this did not work

        With .presentations.Add
            For j = 1 To UBound(sn)
                With .Slides.Add(1, 12).Shapes.AddTextbox(1, 120, 120, 270, 100).TextFrame.TextRange
                  .Text = sn(j, 1) & vbLf & sn(j, 2)
                  .Font.Size = 38
                End With
            Next
        End With
    End With
End Sub

---

Open Existing PPT

Code:

---

Dim FlName As String

    FlName = "C:\Users\DJ-PC\Desktop\DJPartDescriptions.PPTX"

    On Error Resume Next
    Set oPPApp = GetObject(, "PowerPoint.Application")

    If Err.Number <> 0 Then
        Set oPPApp = CreateObject("PowerPoint.Application")

---

and then stuck:sad2:

I have tried everything - nothing works

if you don't mind and know how I can export it into my current PPT - I will be more than obliged to your kindness

thank you very much

DJ

Code:

---

Sub M_snb()
  With getobject("C:\Users\DJ-PC\PartDescriptions.xlsm")
    sn = .Sheets(1).Cells(1).CurrentRegion
    .close 0
  End With
   
  With getObject("C:\Users\DJ-PC\Desktop\DJPartDescriptions.PPTX")
    For j = 1 To UBound(sn)
      With .Slides.Add(1, 12).Shapes.AddTextbox(1, 120, 120, 270, 100).TextFrame.TextRange
        .Text = sn(j, 1) & vbLf & sn(j, 2)
        .Font.Size = 38
      End With
    Next
  End With
End Sub

---

Snb,

thank you yes this added it it my ppt.:checkmark

the last thing I am trying to work out is - am i able to insert it into my current slides.

Or is that too complicated more

I have my slides layed out -

Code:

---


With active.Slides.insert(1, 12).Shapes.AddTextbox(1, 120, 120, 270, 100).TextFrame.TextRange  would this work

---

1 row INSERT into 1 existing slide text box

thank you for going the extra mile - I apologize for it dragging on - I just don't know how to insert it into current slide

I am grateful of your valuable time:biggrin:

dj

Code:

---

Sub M_snb()
    With getobject("C:\Users\DJ-PC\PartDescriptions.xlsm")
        sn = .Sheets(1).Cells(1).CurrentRegion
        .close 0
    End With
   
    With getObject("C:\Users\DJ-PC\Desktop\DJPartDescriptions.PPTX")
        For j = 1 To UBound(sn)
            With .Slides(j).Shapes.AddTextbox(1, 120, 120, 270, 100).TextFrame.TextRange
                .Text = sn(j, 1) & vbLf & sn(j, 2)
                .Font.Size = 38
            End With
        Next
    End With
End Sub

---

snb,

You ROCK!!:super:

I have a hardrive full of old power points so many of them - thanks to your help - no more copy and pasting 1000+ slides for me :biglaugh:

You have made my good week:joy:


thank you for revising the code - many times - that was very generous of you

a very patient and helpful Young Gentleman coder in the community

now i looked all over since yesterday - i still couldn't figure it out :igiveup:

I thank you for your good grace and teaching me how to code:read: - i can learn how to adapt it now

You have the best week ever now

cheers:beerchug:

DJ